hg/stx-libtool: comparison SBrowser.st

equal deleted inserted replaced

-:57c1ccc3d7e0
+:7b48409ae088
-"{ Package: 'Programming Tools' }"
 "
 COPYRIGHT (c) 1989 by Claus Gittinger
 	      All Rights Reserved
 This software is furnished under a license and may be used
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
 "
+'From Smalltalk/X, Version:2.10.4 on 7-nov-1994 at 14:56:27'!
 StandardSystemView subclass:#SystemBrowser
-instanceVariableNames:'classCategoryListView classListView
+	 instanceVariableNames:'classCategoryListView classListView methodCategoryListView
-			      methodCategoryListView methodListView
+		methodListView classMethodListView codeView classToggle
-			      classMethodListView
+		instanceToggle currentClassCategory currentClassHierarchy
-			      codeView classToggle instanceToggle
+		currentClass currentMethodCategory currentMethod currentSelector
-			      currentClassCategory currentClassHierarchy
+		showInstance actualClass fullClass lastMethodCategory aspect
-			      currentClass
+		variableListView fullProtocol lockUpdates autoSearch myLabel'
-			      currentMethodCategory currentMethod
+	 classVariableNames:'CheckForInstancesWhenRemovingClasses'
-			      showInstance actualClass fullClass
+	 poolDictionaries:''
-			      lastMethodCategory aspect variableListView'
+	 category:'Interface-Browsers'
-classVariableNames:''
-poolDictionaries:''
-category:'Interface-Browsers'
 !
 SystemBrowser comment:'
 COPYRIGHT (c) 1989 by Claus Gittinger
 	     All Rights Reserved
-$Header: /cvs/stx/stx/libtool/Attic/SBrowser.st,v 1.14 1994-10-28 03:29:32 claus Exp $
+$Header: /cvs/stx/stx/libtool/Attic/SBrowser.st,v 1.15 1994-11-17 14:47:02 claus Exp $
 '!
 !SystemBrowser class methodsFor:'documentation'!
 copyright
 "
 !
 version
 "
-$Header: /cvs/stx/stx/libtool/Attic/SBrowser.st,v 1.14 1994-10-28 03:29:32 claus Exp $
+$Header: /cvs/stx/stx/libtool/Attic/SBrowser.st,v 1.15 1994-11-17 14:47:02 claus Exp $
 "
 !
 documentation
 "
 this class implements all kinds of class browsers.
-Stypically, it is started with SystemBrowser open, but there are many other startup
+Typically, it is started with 'SystemBrowser open', but there are many other
-messages, to launch special browsers.
+startup messages, to launch special browsers.
-See the extra document 'doc/misc/sbrowser.doc' for how to use this browser.
+See the categories 'startup' and 'special search startup' in the classes
+protocol.
+Alse, see the extra document 'doc/misc/sbrowser.doc' or the HTML online doc
+for how to use the browser.
 written winter 89 by claus
 "
 ! !
-!SystemBrowser class methodsFor:'general startup'!
+!SystemBrowser class methodsFor:'initialization'!
-open
+initialize
-"launch a standard browser"
+"SystemBrowser configuration;
+(values can be changed from your private startup file)"
-^ self openOnDisplay:Display
+"
-"SystemBrowser open"
+setting this to false, the removeClass function will remove
-!
+classes WITHOUT checking for instances. Otherwise,
+it will check and let you confirm in case there are instances.
-openOnDisplay:aDisplay
+Checking for instances may be a bit time consuming, though.
-"launch a standard browser on another display.
+The default is true - therefore, it will check
-Does not work currently - still being developped."
+"
+CheckForInstancesWhenRemovingClasses := true
-^ self newWithLabel:(self classResources string:'System Browser')
-	     setupBlock:[:browser | browser setupForAll]
+"
-		     on:aDisplay
+CheckForInstancesWhenRemovingClasses := true
+CheckForInstancesWhenRemovingClasses := false
-"
-SystemBrowser openOnDisplay:(XWorkstation new initializeFor:'porty:0')
 "
 ! !
 !SystemBrowser class methodsFor:'startup'!
-browseFullClasses
-"launch a browser showing all methods at once"
-^ self newWithLabel:'Full Class Browser'
-	     setupBlock:[:browser | browser setupForFullClass]
-"SystemBrowser browseFullClasses"
-!
-browseClassCategory:aClassCategory
-"launch a browser for all classes under aCategory"
-^ self newWithLabel:aClassCategory
-	     setupBlock:[:browser | browser setupForClassCategory:aClassCategory]
-"SystemBrowser browseClassCategory:'Kernel-Objects'"
-!
-browseClass:aClass
-"launch a browser for aClass"
-^ self newWithLabel:aClass name
-	     setupBlock:[:browser | browser setupForClass:aClass]
-"SystemBrowser browseClass:Object"
-!
-browseClassHierarchy:aClass
-"launch a browser for aClass and all its superclasses"
-^ self newWithLabel:(aClass name , '-' , 'hierarchy')
-	     setupBlock:[:browser | browser setupForClassHierarchy:aClass]
-"SystemBrowser browseClassHierarchy:Number"
-!
-browseClasses:aList title:title
-"launch a browser for all classes in aList"
-^ self newWithLabel:title
-	     setupBlock:[:browser | browser setupForClassList:aList]
-"
-SystemBrowser browseClasses:(Array with:Object
-					with:Float)
-			   title:'two classes'
-"
-!
-browseClass:aClass methodCategory:aCategory
-"launch a browser for all methods under aCategory in aClass"
-^ self newWithLabel:(aClass name , ' ' , aCategory)
-	  setupBlock:[:browser | browser setupForClass:aClass methodCategory:aCategory]
-"SystemBrowser browseClass:String methodCategory:'copying'"
-!
-browseClass:aClass selector:selector
-"launch a browser for the method at selector in aClass"
-^ self newWithLabel:(aClass name , ' ' , selector)
-	  setupBlock:[:browser | browser setupForClass:aClass selector:selector]
-"SystemBrowser browseClass:Object selector:#printString"
-!
 browseMethods:aList title:aString
-"launch a browser for an explicit list of class/selectors"
+"launch a browser for an explicit list of class/selectors.
+Each entry in the list must consist of the classes name and the selector,
+separated by spaces. For class methods, the string 'class' must be
+appended to the classname."
 (aList size == 0) ifTrue:[
 	self showNoneFound:aString.
 	^ nil
 ].
 "
 SystemBrowser browseMethods:#('Object printOn:'
 				   'Collection add:')
 			   title:'some methods'
 "
-!
+"
+SystemBrowser browseMethods:#('Behavior new:'
-browseMethodCategory:aCategory
+				   'Setclass new:')
-"launch a browser for all methods where category = aCategory"
+			   title:'some new: methods'
+"
-|searchBlock|
-aCategory includesMatchCharacters ifTrue:[
-	searchBlock := [:c :m :s | aCategory match:m category].
-] ifFalse:[
-	searchBlock := [:c :m :s | m category = aCategory]
-].
-self browseMethodsWhere:searchBlock title:('all methods with category of ' , aCategory)
-"
-SystemBrowser browseMethodCategory:'printing & storing'
-SystemBrowser browseMethodCategory:'print*'
-"
-!
-browseAllSelect:aBlock
-"launch a browser for all methods where aBlock returns true.
-The block is called with 3 arguments, class, method and seelctor."
-^ self browseMethodsWhere:aBlock title:'selected messages'
-!
-browseMethodsWhere:aBlock title:title
-"launch a browser for all methods where aBlock returns true.
-The block is called with 3 arguments, class, method and seelctor."
-^ self browseMethodsIn:(Smalltalk allClasses) where:aBlock title:title
-!
-browseMethodsOf:aClass where:aBlock title:title
-"launch a browser for all instance- and classmethods in aClass
-where aBlock evaluates to true.
-The block is called with 3 arguments, class, method and seelctor."
-^ self browseMethodsIn:(Array with:aClass) where:aBlock title:title
-!
-browseMethodsFrom:aClass where:aBlock title:title
-"launch a browser for all instance- and classmethods in aClass
-and all its subclasses where aBlock evaluates to true.
-The block is called with 3 arguments, class, method and seelctor."
-^ self browseMethodsIn:(aClass withAllSubclasses) where:aBlock title:title
-!
-browseMethodsIn:aCollectionOfClasses where:aBlock title:title
-"launch a browser for all instance- and classmethods from
-all classes in aCollectionOfClasses where aBlock evaluates to true.
-The block is called with 3 arguments, class, method and seelctor."
-^ self browseMethodsIn:aCollectionOfClasses inst:true class:true where:aBlock title:title
 !
 browseMethodsIn:aCollectionOfClasses inst:wantInst class:wantClass where:aBlock title:title
 "launch a browser for all instance- (if wantInst is true) and/or
 classmethods (if wantClass is true) from classes in aCollectionOfClasses,
 		checkedClasses add:cls.
 	    ]
 	].
 	aCollectionOfClasses do:[:aClass |
+	    "
+	     output disabled - it slows down things too much (when searching for
+	     implementors or senders)
+	    "
 "/            Transcript show:'searching '; show:aClass name; showCr:' ...'; endEntry.
 	    wantInst ifTrue:[checkBlock value:aClass].
 	    wantClass ifTrue:[checkBlock value:(aClass class)].
 	    Processor yield
 	]
 ].
 ^ self browseMethods:list title:title
 !
+browseMethodsIn:aCollectionOfClasses where:aBlock title:title
+"launch a browser for all instance- and classmethods from
+all classes in aCollectionOfClasses where aBlock evaluates to true.
+The block is called with 3 arguments, class, method and seelctor."
+^ self browseMethodsIn:aCollectionOfClasses inst:true class:true where:aBlock title:title
+!
+browseClassCategory:aClassCategory
+"launch a browser for all classes under aCategory"
+^ self newWithLabel:aClassCategory
+	     setupBlock:[:browser | browser setupForClassCategory:aClassCategory]
+"SystemBrowser browseClassCategory:'Kernel-Objects'"
+!
+browseFullClasses
+"launch a browser showing all methods at once"
+^ self newWithLabel:'Full Class Browser'
+	     setupBlock:[:browser | browser setupForFullClass]
+"SystemBrowser browseFullClasses"
+!
+browseClass:aClass
+"launch a browser for aClass"
+^ self newWithLabel:aClass name
+	     setupBlock:[:browser | browser setupForClass:aClass]
+"SystemBrowser browseClass:Object"
+!
+browseClass:aClass selector:selector
+"launch a browser for the method at selector in aClass"
+^ self
+	newWithLabel:(aClass name , ' ' , selector , ' ' , selector)
+	setupBlock:[:browser | browser setupForClass:aClass selector:selector]
+"
+SystemBrowser browseClass:Object selector:#printString
+"
+!
+browseClassHierarchy:aClass
+"launch a browser for aClass and all its superclasses.
+this is different from the fullProtocol browser."
+^ self newWithLabel:(aClass name , '-' , 'hierarchy')
+	     setupBlock:[:browser | browser setupForClassHierarchy:aClass]
+"
+SystemBrowser browseClassHierarchy:Number
+"
+!
+browseFullClassProtocol:aClass
+"launch a browser for aClasses full protocol.
+This is different from hierarchy browsing."
+^ self newWithLabel:(aClass name , '-' , 'full protocol')
+	     setupBlock:[:browser | browser setupForFullClassProtocol:aClass]
+"
+SystemBrowser browseFullClassProtocol:Number
+"
+!
+browseClasses:aList title:title
+"launch a browser for all classes in aList"
+^ self newWithLabel:title
+	     setupBlock:[:browser | browser setupForClassList:aList]
+"
+SystemBrowser browseClasses:(Array with:Object
+					with:Float)
+			   title:'two classes'
+"
+!
+browseClass:aClass methodCategory:aCategory
+"launch a browser for all methods under aCategory in aClass"
+^ self newWithLabel:(aClass name , ' ' , aCategory)
+	  setupBlock:[:browser | browser setupForClass:aClass methodCategory:aCategory]
+"SystemBrowser browseClass:String methodCategory:'copying'"
+!
+browseMethodCategory:aCategory
+"launch a browser for all methods where category = aCategory"
+|searchBlock|
+aCategory includesMatchCharacters ifTrue:[
+	searchBlock := [:c :m :s | aCategory match:m category].
+] ifFalse:[
+	searchBlock := [:c :m :s | m category = aCategory]
+].
+self browseMethodsWhere:searchBlock title:('all methods with category of ' , aCategory)
+"
+SystemBrowser browseMethodCategory:'printing & storing'
+SystemBrowser browseMethodCategory:'print*'
+"
+!
+browseAllSelect:aBlock
+"launch a browser for all methods where aBlock returns true.
+The block is called with 3 arguments, class, method and seelctor."
+^ self browseMethodsWhere:aBlock title:'selected messages'
+"
+SystemBrowser browseAllSelect:[:aClass :aMethod :selector | selector numArgs == 3]
+"
+!
+browseMethodsWhere:aBlock title:title
+"launch a browser for all methods where aBlock returns true.
+The block is called with 3 arguments, class, method and seelctor."
+^ self browseMethodsIn:(Smalltalk allClasses) where:aBlock title:title
+!
+browseMethodsOf:aClass where:aBlock title:title
+"launch a browser for all instance- and classmethods in aClass
+where aBlock evaluates to true.
+The block is called with 3 arguments, class, method and seelctor."
+^ self browseMethodsIn:(Array with:aClass) where:aBlock title:title
+!
+browseMethodsFrom:aClass where:aBlock title:title
+"launch a browser for all instance- and classmethods in aClass
+and all its subclasses where aBlock evaluates to true.
+The block is called with 3 arguments, class, method and seelctor."
+^ self browseMethodsIn:(aClass withAllSubclasses) where:aBlock title:title
+!
 browseInstMethodsOf:aClass where:aBlock title:title
 "launch a browser for all instance methods in aClass
 where aBlock evaluates to true"
 ^ self browseMethodsIn:(Array with:aClass) inst:true class:false where:aBlock title:title
 !
+browseInstMethodsIn:aCollectionOfClasses where:aBlock title:title
+"launch a browser for all instance methods of all classes in
+aCollectionOfClasses where aBlock evaluates to true"
+^ self browseMethodsIn:aCollectionOfClasses inst:true class:false
+		     where:aBlock title:title
+!
 browseInstMethodsFrom:aClass where:aBlock title:title
 "launch a browser for all instance methods in aClass and all subclasses
 where aBlock evaluates to true"
 ^ self browseMethodsIn:(aClass withAllSubclasses) inst:true class:false where:aBlock title:title
 !
-browseInstMethodsIn:aCollectionOfClasses where:aBlock title:title
+browseFullClassHierarchy:aClass
-"launch a browser for all instance methods of all classes in
+"launch a browser for aClass and all its superclasses"
-aCollectionOfClasses where aBlock evaluates to true"
+^ self newWithLabel:(aClass name , '-' , 'full protocol')
-^ self browseMethodsIn:aCollectionOfClasses inst:true class:false
+	     setupBlock:[:browser | browser setupForFullClassHierarchy:aClass]
-		     where:aBlock title:title
+"
+SystemBrowser browseFullClassHierarchy:Number
+"
 ! !
 !SystemBrowser class methodsFor:'special search startup'!
-browseImplementorsOf:aSelectorString in:aCollectionOfClasses title:title
-"launch a browser for all implementors of aSelector in
-the classes contained in aCollectionOfClasses and its metaclasses"
-|list sel|
-list := OrderedCollection new.
-((aSelectorString ~= '*') and:[aSelectorString includesMatchCharacters]) ifTrue:[
-	"a matchString"
-	aCollectionOfClasses do:[:aClass |
-	    aClass selectorArray do:[:aSelector |
-		(aSelectorString match:aSelector) ifTrue:[
-		    list add:(aClass name , ' ' , aSelector)
-		]
-	    ].
-	    aClass class selectorArray do:[:aSelector |
-		(aSelectorString match:aSelector) ifTrue:[
-		    list add:(aClass name , 'class ' , aSelector)
-		]
-	    ]
-	]
-] ifFalse:[
-	"can do a faster search"
-	aSelectorString knownAsSymbol ifFalse:[
-	    self showNoneFound:title.
-	    ^ nil
-	].
-	sel := aSelectorString asSymbol.
-	aCollectionOfClasses do:[:aClass |
-	    (aClass implements:sel) ifTrue:[
-		list add:(aClass name , ' ' , aSelectorString)
-	    ].
-	    (aClass class implements:sel) ifTrue:[
-		list add:(aClass name , 'class ' , aSelectorString)
-	    ]
-	]
-].
-^ self browseMethods:list title:title
-"
-SystemBrowser browseImplementorsOf:#+
-				     in:(Array with:Number
-					       with:Float
-					       with:SmallInteger)
-				  title:'some implementors of +'
-"
-!
-browseImplementorsOf:aSelectorString
-"launch a browser for all implementors of aSelector"
-^ self browseImplementorsOf:aSelectorString
-			     in:(Smalltalk allClasses)
-			  title:('implementors of: ' , aSelectorString)
-"
-SystemBrowser browseImplementorsOf:#+
-"
-!
-browseImplementorsOf:aSelectorString under:aClass
-"launch a browser for all implementors of aSelector in aClass
-and its subclasses"
-^ self browseImplementorsOf:aSelectorString
-			     in:(aClass withAllSubclasses)
-			  title:('implementors of: ' ,
-				 aSelectorString ,
-				 ' (in or below ' , aClass name , ')')
-"
-SystemBrowser browseImplementorsOf:#+ under:Integer
-"
-!
 browseAllCallsOn:aSelectorString in:aCollectionOfClasses title:title
 "launch a browser for all senders of aSelector in aCollectionOfClasses"
 |sel browser searchBlock|
 				  where:[:class :method :s | method sends:sel]
 				  title:title
 ].
 browser notNil ifTrue:[
-	browser setSearchPattern:aSelectorString
+	|s|
+	"
+	 kludge for now, if its a multipart selector,
+	 no easy search is (as yet) possible
+	"
+	s := aSelectorString.
+	(s includes:$:) ifTrue:[
+	    s := s copyTo:(s indexOf:$:)
+	].
+	browser autoSearch:s
 ].
 ^ browser
+!
+browseImplementorsOf:aSelectorString
+"launch a browser for all implementors of aSelector"
+^ self browseImplementorsOf:aSelectorString
+			     in:(Smalltalk allClasses)
+			  title:('implementors of: ' , aSelectorString)
+"
+SystemBrowser browseImplementorsOf:#+
+"
+!
+browseImplementorsOf:aSelectorString in:aCollectionOfClasses title:title
+"launch a browser for all implementors of aSelector in
+the classes contained in aCollectionOfClasses and its metaclasses"
+|list sel|
+list := OrderedCollection new.
+((aSelectorString ~= '*') and:[aSelectorString includesMatchCharacters]) ifTrue:[
+	"a matchString"
+	aCollectionOfClasses do:[:aClass |
+	    aClass selectorArray do:[:aSelector |
+		(aSelectorString match:aSelector) ifTrue:[
+		    list add:(aClass name , ' ' , aSelector)
+		]
+	    ].
+	    aClass class selectorArray do:[:aSelector |
+		(aSelectorString match:aSelector) ifTrue:[
+		    list add:(aClass name , 'class ' , aSelector)
+		]
+	    ]
+	]
+] ifFalse:[
+	"can do a faster search"
+	aSelectorString knownAsSymbol ifFalse:[
+	    self showNoneFound:title.
+	    ^ nil
+	].
+	sel := aSelectorString asSymbol.
+	aCollectionOfClasses do:[:aClass |
+	    (aClass implements:sel) ifTrue:[
+		list add:(aClass name , ' ' , aSelectorString)
+	    ].
+	    (aClass class implements:sel) ifTrue:[
+		list add:(aClass name , 'class ' , aSelectorString)
+	    ]
+	]
+].
+^ self browseMethods:list title:title
+"
+SystemBrowser browseImplementorsOf:#+
+				     in:(Array with:Number
+					       with:Float
+					       with:SmallInteger)
+				  title:'some implementors of +'
+"
 !
 browseAllCallsOn:aSelectorString
 "launch a browser for all senders of aSelector"
 			     aSelectorString ,
 			     ' (in or below ' , aClass name , ')')
 "
 SystemBrowser browseAllCallsOn:#+ under:Number
+"
+!
+browseImplementorsOf:aSelectorString under:aClass
+"launch a browser for all implementors of aSelector in aClass
+and its subclasses"
+^ self browseImplementorsOf:aSelectorString
+			     in:(aClass withAllSubclasses)
+			  title:('implementors of: ' ,
+				 aSelectorString ,
+				 ' (in or below ' , aClass name , ')')
+"
+SystemBrowser browseImplementorsOf:#+ under:Integer
 "
 !
 browseForSymbol:aSymbol title:title warnIfNone:doWarn
 "launch a browser for all methods referencing aSymbol"
 			    found
 		       ].
 ].
 browser := self browseMethodsWhere:[:c :m :s | searchBlock value:(m literals)] title:title.
 browser notNil ifTrue:[
-	browser setSearchPattern:aSymbol
+	browser autoSearch:aSymbol
 ].
 ^ browser
 !
-browseForSymbol:aSymbol
+filterToSearchInstRefsTo:varName modificationsOnly:modsOnly
-"launch a browser for all methods referencing aSymbol"
+"return a block to search for instvar accesses"
-^ self browseForSymbol:aSymbol title:('users of ' , aSymbol) warnIfNone:true
+|searchBlock|
-!
-browseReferendsOf:aGlobalName warnIfNone:doWarn
-"launch a browser for all methods referencing a global
-named aGlobalName.
-"
-^ self browseForSymbol:aGlobalName title:('users of: ' , aGlobalName) warnIfNone:doWarn
-!
-browseReferendsOf:aGlobalName
-"launch a browser for all methods referencing a global
-named aGlobalName.
-"
-^ self browseReferendsOf:aGlobalName warnIfNone:true
-"
-Browser browseReferendsOf:#Transcript
-"
-!
-browseForString:aString in:aCollectionOfClasses
-"launch a browser for all methods in aCollectionOfClasses
-containing a string-constant"
-|browser searchBlock title|
-title := 'methods containing: ' , aString displayString.
-(aString includesMatchCharacters) ifTrue:[
-	"a matchString"
-	searchBlock := [:lits |
-			    |found|
-			    found := false.
-			    lits notNil ifTrue:[
-				lits do:[:aLiteral |
-				    found ifFalse:[
-					(aLiteral isMemberOf:String) ifTrue:[
-					    found := (aString match:aLiteral)
-					]
-				    ]
-				]
-			    ].
-			    found
-		       ].
-] ifFalse:[
-	searchBlock := [:lits |
-			    |found|
-			    found := false.
-			    lits notNil ifTrue:[
-				lits do:[:aLiteral |
-				    found ifFalse:[
-					(aLiteral isMemberOf:String) ifTrue:[
-					    found := (aLiteral = aString)
-					]
-				    ]
-				]
-			    ].
-			    found
-		       ].
-].
-browser := self browseMethodsIn:aCollectionOfClasses
-			      where:[:c :m :s | searchBlock value:(m literals)]
-			      title:title.
-browser notNil ifTrue:[
-	browser setSearchPattern:aString
-].
-^ browser
-"SystemBrowser browseForString:'*all*'"
-"SystemBrowser browseForString:'*should*'"
-"SystemBrowser browseForString:'*[eE]rror*'"
-!
-browseForString:aString
-"launch a browser for all methods containing a string"
-^ self browseForString:aString in:(Smalltalk allClasses)
-!
-aproposSearch:aString in:aCollectionOfClasses
-"browse all methods, which have aString in their selector or
-in the methods comment.
-This is relatively slow, since all source must be processed."
-|matchString list|
-matchString := '*' , aString , '*'.
-list := OrderedCollection new.
-^ self browseMethodsIn:aCollectionOfClasses
-		     where:[:class :method :sel |
-				(matchString match:sel) ifTrue:[
-				    list add:(class name , '>>' , sel)
-				] ifFalse:[
-				    (matchString match:(method comment)) ifTrue:[
-					list add:(class name , '>>' , sel)
-				    ]
-				].
-				Processor yield.
-			   ]
-		     title:('apropos: ' , aString)
-"SystemBrowser aproposSearch:'append'"
-"SystemBrowser aproposSearch:'add'"
-"SystemBrowser aproposSearch:'sort'"
-!
-aproposSearch:aString
-"browse all methods, which have aString in their selector or
-in the methods comment.
-This is relatively slow, since all source must be processed."
-^ self aproposSearch:aString in:(Smalltalk allClasses)
-!
-browseInstRefsTo:varName in:aCollectionOfClasses modificationsOnly:modsOnly title:title
-"launch a browser for all methods in aClass where the instVar named
-varName is referenced; if modsOnly is true, browse only methods where the
-instvar is modified"
-|searchBlock browser needMatch|
-needMatch := varName includesMatchCharacters.
 searchBlock := [:c :m :s |
-	|src result parser instvars|
+	|src result parser instvars needMatch|
+	needMatch := varName includesMatchCharacters.
 	src := m source.
 	src isNil ifTrue:[
 	    result := false
 	] ifFalse:[
 	    ].
 	].
 	Processor yield.
 	result
 ].
-browser := self browseInstMethodsIn:aCollectionOfClasses where:searchBlock title:title.
+^ searchBlock
+!
+browseForSymbol:aSymbol
+"launch a browser for all methods referencing aSymbol"
+^ self browseForSymbol:aSymbol title:('users of ' , aSymbol) warnIfNone:true
+!
+browseReferendsOf:aGlobalName warnIfNone:doWarn
+"launch a browser for all methods referencing a global
+named aGlobalName.
+"
+^ self browseForSymbol:aGlobalName title:('users of: ' , aGlobalName) warnIfNone:doWarn
+!
+browseReferendsOf:aGlobalName
+"launch a browser for all methods referencing a global
+named aGlobalName.
+"
+^ self browseReferendsOf:aGlobalName warnIfNone:true
+"
+Browser browseReferendsOf:#Transcript
+"
+!
+browseUsesOf:aClass
+|dict owners offsets
+sz  "{ Class: SmallInteger }"
+n   "{ Class: SmallInteger }"
+removeSet newDict|
+owners := ObjectMemory whoReferencesInstancesOf:aClass.
+"
+collect set of offsets in dict; key is class
+"
+dict := IdentityDictionary new.
+owners do:[:someObject |
+	|cls create|
+	someObject isContext ifFalse:[
+	    "
+	     someObject refers to an instance of aClass;
+	     find out, which instVar(s)
+	    "
+	    cls := someObject class.
+	    cls ~~ Array ifTrue:[
+		n := cls instSize.
+		create := [|s| s := Set new. dict at:cls put:s. s].
+		1 to:n do:[:i |
+		    |ref|
+		    ref := someObject instVarAt:i.
+		    (ref isMemberOf:aClass) ifTrue:[
+			offsets := dict at:cls ifAbsent:create.
+			offsets add:i.
+		    ]
+		].
+		cls isVariable ifTrue:[
+		    cls isPointers ifTrue:[
+			| idx "{ Class: SmallInteger }" |
+			sz := someObject basicSize.
+			idx := 1.
+			[idx <= sz] whileTrue:[
+			    |ref|
+			    ref := someObject basicAt:idx.
+			    (ref isMemberOf:aClass) ifTrue:[
+				offsets := dict at:cls ifAbsent:create.
+				offsets add:0.
+				idx := sz
+			    ].
+			    idx := idx + 1
+			]
+		    ]
+		]
+	    ]
+	]
+].
+"
+merge with superclass refs
+"
+dict keysAndValuesDo:[:cls :set |
+	cls allSuperclasses do:[:aSuperclass |
+	    |superSet|
+	    superSet := dict at:aSuperclass ifAbsent:[].
+	    superSet notNil ifTrue:[
+		|removeSet|
+		superSet := dict at:aSuperclass.
+		removeSet := Set new.
+		set do:[:offset |
+		    (superSet includes:offset) ifTrue:[
+			removeSet add:offset
+		    ]
+		].
+		set removeAll:removeSet
+	    ]
+	]
+].
+"
+remove empty ones
+"
+removeSet := Set new.
+dict keysAndValuesDo:[:cls :set |
+	set isEmpty ifTrue:[
+	    removeSet add:cls
+	]
+].
+removeSet do:[:cls |
+	dict removeKey:cls
+].
+"
+replace the indices by real names
+"
+newDict := IdentityDictionary new.
+dict keysAndValuesDo:[:cls :set |
+	|newSet names|
+	names := cls allInstVarNames.
+	newSet := set collect:[:index |
+		index == 0 ifTrue:['*indexed*'] ifFalse:[names at:index].
+	].
+	newDict at:cls put:newSet
+].
+newDict inspect
+!
+browseForString:aString in:aCollectionOfClasses
+"launch a browser for all methods in aCollectionOfClasses
+containing a string-constant"
+|browser searchBlock title|
+title := 'methods containing: ' , aString displayString.
+(aString includesMatchCharacters) ifTrue:[
+	"a matchString"
+	searchBlock := [:lits |
+			    |found|
+			    found := false.
+			    lits notNil ifTrue:[
+				lits do:[:aLiteral |
+				    found ifFalse:[
+					(aLiteral isMemberOf:String) ifTrue:[
+					    found := (aString match:aLiteral)
+					]
+				    ]
+				]
+			    ].
+			    found
+		       ].
+] ifFalse:[
+	searchBlock := [:lits |
+			    |found|
+			    found := false.
+			    lits notNil ifTrue:[
+				lits do:[:aLiteral |
+				    found ifFalse:[
+					(aLiteral isMemberOf:String) ifTrue:[
+					    found := (aLiteral = aString)
+					]
+				    ]
+				]
+			    ].
+			    found
+		       ].
+].
+browser := self browseMethodsIn:aCollectionOfClasses
+			      where:[:c :m :s | searchBlock value:(m literals)]
+			      title:title.
 browser notNil ifTrue:[
-	browser setSearchPattern:varName
+	browser autoSearch:aString
 ].
 ^ browser
+"SystemBrowser browseForString:'*all*'"
+"SystemBrowser browseForString:'*should*'"
+"SystemBrowser browseForString:'*[eE]rror*'"
+!
+browseForString:aString
+"launch a browser for all methods containing a string"
+^ self browseForString:aString in:(Smalltalk allClasses)
+!
+browseInstRefsTo:varName in:aCollectionOfClasses modificationsOnly:modsOnly title:title
+"launch a browser for all methods in aClass where the instVar named
+varName is referenced; if modsOnly is true, browse only methods where the
+instvar is modified"
+|filter browser|
+filter := self filterToSearchInstRefsTo:varName modificationsOnly:modsOnly.
+browser := self browseInstMethodsIn:aCollectionOfClasses where:filter title:title.
+browser notNil ifTrue:[
+	browser autoSearch:varName
+].
+^ browser
+!
+aproposSearch:aString in:aCollectionOfClasses
+"browse all methods, which have aString in their selector or
+in the methods comment.
+This is relatively slow, since all source must be processed."
+|matchString list|
+matchString := '*' , aString , '*'.
+list := OrderedCollection new.
+^ self browseMethodsIn:aCollectionOfClasses
+		     where:[:class :method :sel |
+				(matchString match:sel) ifTrue:[
+				    list add:(class name , '>>' , sel)
+				] ifFalse:[
+				    (matchString match:(method comment)) ifTrue:[
+					list add:(class name , '>>' , sel)
+				    ]
+				].
+				Processor yield.
+			   ]
+		     title:('apropos: ' , aString)
+"SystemBrowser aproposSearch:'append'"
+"SystemBrowser aproposSearch:'add'"
+"SystemBrowser aproposSearch:'sort'"
 !
 browseInstRefsTo:aString in:aCollectionOfClasses modificationsOnly:modsOnly
 "launch a browser for all methods in aClass where the instVar named
 aString is referenced; if modsOnly is true, browse only methods where the
 			 in:aCollectionOfClasses
 	  modificationsOnly:modsOnly
 		      title:(title , aString)
 !
+aproposSearch:aString
+"browse all methods, which have aString in their selector or
+in the methods comment.
+This is relatively slow, since all source must be processed."
+^ self aproposSearch:aString in:(Smalltalk allClasses)
+!
 browseInstRefsTo:aString under:aClass modificationsOnly:modsOnly
 "launch a browser for all methods in aClass and subclasses
 where the instVar named aString is referenced;
 if modsOnly is true, browse only methods where the instvar is modified"
 browseClassRefsTo:varName in:aCollectionOfClasses modificationsOnly:modsOnly title:title
 "launch a browser for all methods in aCollectionOfClasses,
 where the classVar named aString is referenced;
 if modsOnly is true, browse only methods where the classvar is modified"
-|needMatch searchBlock browser|
+|searchBlock browser|
-needMatch := varName includesMatchCharacters.
+searchBlock := self filterToSearchClassRefsTo:varName modificationsOnly:modsOnly.
+browser := self browseMethodsIn:aCollectionOfClasses where:searchBlock title:title.
+browser notNil ifTrue:[
+	browser autoSearch:varName
+].
+^ browser
+!
+browseClassRefsTo:aString in:aCollectionOfClasses modificationsOnly:modsOnly
+"launch a browser for all methods in aClass where the classVar named
+aString is referenced; if modsOnly is true, browse only methods where the
+classvar is modified"
+|title|
+modsOnly ifTrue:[
+	title := 'modifications of '
+] ifFalse:[
+	title := 'references to '
+].
+^ self browseClassRefsTo:aString in:aCollectionOfClasses modificationsOnly:modsOnly title:(title , aString)
+!
+browseClassRefsTo:aString under:aClass modificationsOnly:modsOnly
+"launch a browser for all methods in aClass and subclasses
+where the classVar named aString is referenced;
+if modsOnly is true, browse only methods where the classvar is modified"
+^ self browseClassRefsTo:aString in:(aClass withAllSubclasses) modificationsOnly:modsOnly
+!
+filterToSearchClassRefsTo:varName modificationsOnly:modsOnly
+"return a searchblock for class variable references"
+|searchBlock|
 searchBlock := [:c :m :s |
-	|src result parser classvars|
+	|src result parser classvars needMatch|
+	needMatch := varName includesMatchCharacters.
 	src := m source.
 	src isNil ifTrue:[
 	    result := false
 	] ifFalse:[
 	    ].
 	].
 	Processor yield.
 	result
 ].
-browser := self browseMethodsIn:aCollectionOfClasses where:searchBlock title:title.
+^ searchBlock
-browser notNil ifTrue:[
-	browser setSearchPattern:varName
-].
-^ browser
-!
-browseClassRefsTo:aString in:aCollectionOfClasses modificationsOnly:modsOnly
-"launch a browser for all methods in aClass where the classVar named
-aString is referenced; if modsOnly is true, browse only methods where the
-classvar is modified"
-|title|
-modsOnly ifTrue:[
-	title := 'modifications of '
-] ifFalse:[
-	title := 'references to '
-].
-^ self browseClassRefsTo:aString in:aCollectionOfClasses modificationsOnly:modsOnly title:(title , aString)
-!
-browseClassRefsTo:aString under:aClass modificationsOnly:modsOnly
-"launch a browser for all methods in aClass and subclasses
-where the classVar named aString is referenced;
-if modsOnly is true, browse only methods where the classvar is modified"
-^ self browseClassRefsTo:aString in:(aClass withAllSubclasses) modificationsOnly:modsOnly
 ! !
 !SystemBrowser class methodsFor:'private'!
+newWithLabel:aString setupBlock:aBlock on:aWorkstation
+"common helper method for all creation methods"
+|newBrowser|
+newBrowser := self on:aWorkstation.
+newBrowser title:aString.
+aBlock value:newBrowser.
+newBrowser open.
+^ newBrowser
+!
+newWithLabel:aString setupBlock:aBlock
+"common helper method for all creation methods"
+^ self newWithLabel:aString setupBlock:aBlock on:Display
+!
 showNoneFound:what
 "/    DialogView warn:(self classResources string:('no ' , what , ' found')).
 self showNoneFound
 !
 showNoneFound
 DialogView warn:(self classResources string:'None found').
-!
+! !
-newWithLabel:aString setupBlock:aBlock on:aWorkstation
+!SystemBrowser class methodsFor:'general startup'!
-"common helper method for all creation methods"
+openOnDisplay:aDisplay
-|newBrowser|
+"launch a standard browser on another display.
+Does not work currently - still being developped."
-newBrowser := self on:aWorkstation.
-newBrowser label:aString.
+^ self newWithLabel:(self classResources string:'System Browser')
-aBlock value:newBrowser.
+	     setupBlock:[:browser | browser setupForAll]
+		     on:aDisplay
-newBrowser open.
-^ newBrowser
+"
-!
+SystemBrowser openOnDisplay:(XWorkstation new initializeFor:'porty:0')
+"
-newWithLabel:aString setupBlock:aBlock
+!
-"common helper method for all creation methods"
+open
-^ self newWithLabel:aString setupBlock:aBlock on:Display
+"launch a standard browser"
+^ self openOnDisplay:Display
+"SystemBrowser open"
+! !
+!SystemBrowser methodsFor:'dependencies'!
+update:something with:someArgument from:changedObject
+"
+avoid update/warn after my own changes
+"
+lockUpdates == true ifTrue:[
+"/         'ignored my change' printNL.
+	^ self
+].
+"/ changedObject print. ' ' print. someArgument print. ' ' print.
+"/ something printNL.
+(changedObject == Smalltalk) ifTrue:[
+	something == #newClass ifTrue:[
+	    ((someArgument category = currentClassCategory)
+	    or:[currentClassCategory notNil
+		and:[currentClassCategory startsWith:'*']]) ifTrue:[
+		self updateClassListWithScroll:false.
+	    ].
+	    someArgument category ~= currentClassCategory ifTrue:[
+		"
+		 category new ?
+		"
+		(classCategoryListView notNil
+		and:[classCategoryListView list notNil
+		and:[(classCategoryListView list includes:someArgument category) not]])
+		ifTrue:[
+		    self updateClassCategoryListWithScroll:false.
+		]
+	    ].
+	    ^ self
+	].
+	something == #classRemove ifTrue:[
+	    someArgument = currentClass ifTrue:[
+		self warnLabel:'the selected class was removed'.
+		^ self
+	    ].
+	    " fall into general update "
+	].
+	"
+	 any other (unknown) change
+	 with the Smalltalk dictionary ...
+	"
+	self updateClassCategoryListWithScroll:false.
+	self updateClassListWithScroll:false.
+	^ self
+].
+changedObject isBehavior ifTrue:[
+	"
+	 its a class, that has changed
+	"
+	(currentClass notNil
+	and:[changedObject name = currentClass name]) ifTrue:[
+	    "
+	     its the current class that has changed
+	    "
+	    something == #methodDictionary ifTrue:[
+		(someArgument isSymbol) ifTrue:[
+		    |changedMethod|
+		    "
+		     the method with selector someArgument was changed or removed
+		    "
+		    self updateMethodCategoryListWithScroll:false.
+		    self updateMethodListWithScroll:false.
+		    someArgument == currentSelector ifTrue:[
+			"
+			 special care here: the currently shown method has been
+			 changed somehow in another browser (or via fileIn)
+			"
+			changedMethod := currentClass compiledMethodAt:currentSelector.
+			changedMethod isNil ifTrue:[
+			    self warnLabel:'the method shown was removed'.
+			    ^ self
+			].
+			"compare the source codes"
+			self warnLabel:'the code shown may not up to date'.
+			^ self
+		    ].
+		    ^ self
+		]
+	    ].
+	    something == #comment ifTrue:[
+		"
+		 the class has changed its comment; we dont care, except if
+		 currently showing the comment
+		"
+		aspect == #comment ifTrue:[
+		    self warnLabel:'the comment shown may not up to date'.
+		].
+		^ self
+	    ].
+	    something == #definition ifTrue:[
+		"
+		 the class has changed its definition.
+		 Warn, except if showing a method.
+		"
+		aspect notNil ifTrue:[
+		    self warnLabel:'the classes definition has changed'.
+		].
+		^ self
+	    ].
+	    "
+	     get the class again - in case of a changed class definition,
+	     we are otherwise refering to the obsolete old class
+	    "
+	    currentClass := Smalltalk at:(currentClass name asSymbol).
+	    showInstance ifTrue:[
+		actualClass := currentClass
+	    ] ifFalse:[
+		actualClass := currentClass class
+	    ].
+	    self updateMethodCategoryListWithScroll:false.
+	    "dont update codeView ...."
+	    "self update"
+	    ^ self
+	].
+	"
+	 any other class has changed (but not its organization, since
+	 that is cought in the above case).
+	 We are not interrested in it - except, if showing fullProtocol
+	 or hierarchy ...
+	"
+	currentClassHierarchy notNil ifTrue:[
+	    fullProtocol ifTrue:[
+		(currentClass isSubclassOf:changedObject) ifTrue:[
+		]
+	    ] ifFalse:[
+		((currentClass isSubclassOf:changedObject)
+		or:[changedObject isSubclassOf:currentClass]) ifTrue:[
+		]
+	    ]
+	].
+	^ self
+].
+(changedObject isKindOf:Method) ifTrue:[
+]
+! !
+!SystemBrowser methodsFor:'private'!
+normalLabel
+"set the normal (inactive) window- and icon labels"
+|l il sel|
+myLabel notNil ifTrue:[
+	l := il := myLabel
+] ifFalse:[
+	l := resources string:'System Browser'.
+	currentClass notNil ifTrue:[
+	    l := l, ': ', currentClass name.
+	    classListView isNil ifTrue:[
+		currentSelector notNil ifTrue:[
+		    l := l , ' ' ,  currentSelector
+		]
+	    ].
+	    il := currentClass name
+	] ifFalse:[
+	    il := l.
+	]
+].
+self label:l.
+self iconLabel:il.
+!
+setAcceptAndExplainActionsForMethod
+"tell the codeView what to do on accept and explain"
+codeView acceptAction:[:theCode |
+	|cat|
+	codeView cursor:Cursor execute.
+	(cat := currentMethodCategory) = '* all *' ifTrue:[
+	    "must check from which category this code came from ...
+	     ... thanks to Arno for pointing this out"
+	    cat := self askForMethodCategory.
+	].
+	(cat notNil and:[cat notEmpty]) ifTrue:[
+	    Object abortSignal catch:[
+		lockUpdates := true.
+		actualClass compiler
+		    compile:theCode asString
+		    forClass:actualClass
+		    inCategory:cat
+		    notifying:codeView.
+		codeView modified:false.
+		self updateMethodListWithScroll:false.
+	    ].
+	    lockUpdates := false.
+	].
+	codeView cursor:Cursor normal.
+].
+codeView explainAction:[:theCode :theSelection |
+	self showExplanation:(Explainer
+				explain:theSelection
+				in:theCode
+				forClass:actualClass)
+].
+!
+checkSelectionChangeAllowed
+"return true, if selection change is ok;
+its not ok, if code has been changed.
+in this case, return the result of a user query"
+|box|
+codeView modified ifFalse:[
+	^ true
+].
+"/    fullProtocol ifTrue:[^ true].
+box := YesNoBox
+	       title:(resources at:'contents in codeview has not been accepted.\\Modifications will be lost when continuing.') withCRs
+	       yesText:(resources at:'continue')
+	       noText:(resources at:'abort').
+^ box confirm
+!
+selectorToSearchFor
+"look in codeView and methodListView for a search-string when searching for selectors"
+|sel t|
+sel := codeView selection.
+sel notNil ifTrue:[
+	sel := sel asString.
+	t := Parser selectorInExpression:sel.
+	t notNil ifTrue:[
+	    sel := t
+	].
+	sel := sel withoutSpaces.
+	sel == #>> ifTrue:[
+	    "oops - thats probably not what we want here ..."
+	    self extractClassAndSelectorFromSelectionInto:[:c :s :m |
+		sel := s
+	    ]
+	]
+] ifFalse:[
+	methodListView notNil ifTrue:[
+	    sel := methodListView selectionValue
+	] ifFalse:[
+	    classMethodListView notNil ifTrue:[
+		sel := classMethodListView selectionValue.
+		sel notNil ifTrue:[
+		    sel := self selectorFromClassMethodString:sel
+		]
+	    ]
+	].
+	sel notNil ifTrue:[
+	    sel := sel withoutSpaces
+	] ifFalse:[
+	    sel := ''
+	]
+].
+^ sel
+!
+enterBoxTitle:title okText:okText
+"convenient method: setup enterBox"
+|box|
+box := EnterBox new.
+box title:(resources string:title) okText:(resources string:okText).
+^ box
+!
+askAndBrowseSelectorTitle:title action:aBlock
+"convenient method: setup enterBox with text from codeView or selected
+method for browsing based on a selector. Set action and launch box"
+|box|
+box := self enterBoxTitle:title okText:'browse'.
+box initialText:(self selectorToSearchFor).
+box action:[:aString | self withCursor:(Cursor questionMark) do:[aBlock value:aString]].
+box showAtPointer
+!
+setSearchPattern:aString
+codeView setSearchPattern:aString
+!
+listBoxTitle:title okText:okText list:aList
+"convenient method: setup a listBox & return it"
+|box|
+box := ListSelectionBox new.
+box okText:(resources string:okText).
+box title:(resources string:title).
+box list:aList.
+^ box
+!
+showExplanation:someText
+"show explanation from Parser"
+self notify:someText
+!
+stringToSearchFor
+"look in codeView and methodListView for a search-string when searching for classes/names"
+|sel|
+sel := codeView selection.
+sel notNil ifTrue:[
+	sel := sel asString withoutSpaces
+] ifFalse:[
+	sel isNil ifTrue:[
+	    currentClass notNil ifTrue:[
+		sel := currentClass name
+	    ]
+	].
+	sel notNil ifTrue:[
+	    sel := sel withoutSpaces
+	] ifFalse:[
+	    sel := ''
+	]
+].
+^ sel
+!
+findClassOfVariable:aVariableName accessWith:aSelector
+"this method returns the class, in which a variable
+is defined;
+needs either #instVarNames or #classVarNames as aSelector."
+|cls homeClass|
+"
+first, find the class, where the variable is declared
+"
+cls := currentClass.
+[cls notNil] whileTrue:[
+	((cls perform:aSelector) includes:aVariableName) ifTrue:[
+	    homeClass := cls.
+	    cls := nil.
+	] ifFalse:[
+	    cls := cls superclass
+	]
+].
+homeClass isNil ifTrue:[
+	"nope, must be one below ... (could optimize a bit, by searching down
+	 for the declaring class ...
+	"
+	homeClass := currentClass
+] ifFalse:[
+"/        Transcript showCr:'starting search in ' , homeClass name.
+].
+^ homeClass
+!
+enterBoxForSearchSelectorTitle:title
+"convenient method: setup enterBox with text from codeView or selected
+method for browsing based on a selector"
+|box|
+box := self enterBoxTitle:title okText:'search'.
+box initialText:(self selectorToSearchFor).
+^ box
+!
+enterBoxForCodeSelectionTitle:title okText:okText
+"convenient method: setup enterBox with text from codeview"
+|sel box|
+box := self enterBoxTitle:(resources string:title) okText:(resources string:okText).
+sel := codeView selection.
+sel notNil ifTrue:[
+	box initialText:(sel asString withoutSeparators)
+].
+^ box
+!
+classesInFullProtocolHierarchy:aClass do:aBlock
+"evaluate aBlock for all non-striked out classes in
+the hierarchy"
+|index|
+index := (classListView list size).
+aClass withAllSuperclasses do:[:c |
+	(classListView isInSelection:index) ifFalse:[
+	    aBlock value:c
+	].
+	index := index - 1
+]
+!
+enterBoxForBrowseTitle:title action:aBlock
+"convenient method: setup enterBox with text from codeView or selected
+method for method browsing based on className/variable"
+|box|
+box := self enterBoxTitle:title okText:'browse'.
+box initialText:(self stringToSearchFor).
+box action:[:aString | self withWaitCursorDo:[aBlock value:aString]].
+box showAtPointer
+!
+askBoxTitle:title okText:okText initialText:initialText action:aBlock
+"convenient method: setup enterBox, and open it"
+|box|
+box := EnterBox new.
+box title:(resources string:title) okText:(resources string:okText).
+box initialText:initialText.
+box action:[:aString | self withWaitCursorDo:aBlock value:aString].
+box showAtPointer
+!
+askAndBrowseMethodCategory:title action:aBlock
+"convenient method: setup enterBox with initial being current method category"
+|sel box|
+box := self enterBoxTitle:title okText:'browse'.
+sel := codeView selection.
+sel isNil ifTrue:[
+	currentMethodCategory notNil ifTrue:[
+	    sel := currentMethodCategory
+	]
+].
+sel notNil ifTrue:[
+	box initialText:(sel asString withoutSpaces)
+].
+box action:[:aString | self withWaitCursorDo:[aBlock value:aString]].
+box showAtPointer
+!
+classHierarchyDo:aBlock
+"eavluate the 2-arg block for every class,
+starting at Object; passing class and nesting level to the block."
+|classes s classDict l|
+classes := Smalltalk allClasses.
+classDict := IdentityDictionary new:classes size.
+classes do:[:aClass |
+	s := aClass superclass.
+	s notNil ifTrue:[
+	    l := classDict at:s ifAbsent:[nil].
+	    l isNil ifTrue:[
+		l := OrderedCollection new:5.
+		classDict at:s put:l
+	    ].
+	    l add:aClass
+	]
+].
+self classHierarchyOf:Object level:0 do:aBlock using:classDict
+!
+classHierarchyOf:aClass level:level do:aBlock using:aDictionary
+"evaluate the 2-arg block for every subclass of aClass,
+passing class and nesting level to the block."
+|names subclasses|
+aBlock value:aClass value:level.
+subclasses := aDictionary at:aClass ifAbsent:[nil].
+(subclasses size == 0) ifFalse:[
+	names := subclasses collect:[:class | class name].
+	names sortWith:subclasses.
+	subclasses do:[:aSubClass |
+	    self classHierarchyOf:aSubClass level:(level + 1) do:aBlock using:aDictionary
+	]
+]
+!
+compileCode:someCode
+(ReadStream on:someCode) fileIn
+!
+extractClassAndSelectorFromSelectionInto:aBlock
+"given a string which can be either 'class>>sel' or
+'class sel', extract className and selector, and call aBlock with
+the result."
+|sel clsName isMeta sep s|
+sel := codeView selection.
+sel notNil ifTrue:[
+	sel := sel asString withoutSeparators.
+	('*>>*' match:sel) ifTrue:[
+	    sep := $>
+	] ifFalse:[
+	    ('* *' match:sel) ifTrue:[
+		sep := Character space
+	    ]
+	].
+	sep notNil ifTrue:[
+	    "
+	     extract class/sel from selection
+	    "
+	    s := ReadStream on:sel.
+	    clsName := s upTo:sep.
+	    [s peek == sep] whileTrue:[s next].
+	    sel := s upToEnd.
+	    (clsName endsWith:'class') ifTrue:[
+		isMeta := true.
+		clsName := clsName copyTo:(clsName size - 5)
+	    ] ifFalse:[
+		isMeta := false
+	    ].
+	]
+].
+aBlock value:clsName value:sel value:isMeta
+!
+classesInHierarchy:aClass do:aBlock
+|index|
+index := (classListView list size).
+aClass withAllSuperclasses do:[:c |
+	(classListView isInSelection:index) ifFalse:[
+	    aBlock value:c
+	].
+	index := index - 1
+]
+!
+askForMethodCategory
+|someCategories box txt|
+someCategories := actualClass categories sort.
+box := self listBoxTitle:'accept in which method category ?' okText:'accept' list:someCategories.
+lastMethodCategory isNil ifTrue:[
+	txt := 'new methods'
+] ifFalse:[
+	txt := lastMethodCategory
+].
+box initialText:txt.
+box action:[:aString |
+		    ^ aString
+	       ].
+box showAtPointer.
+^ nil
+!
+warnLabel:what
+"set the title for some warning"
+self label:('System Browser WARNING: ' , what)
+!
+busyLabel:what with:someArgument
+"set the title for some warning"
+self label:('System Browser:' , (resources string:what with:someArgument))
+! !
+!SystemBrowser methodsFor:'method stuff'!
+updateMethodListWithScroll:scroll
+|selectors scr first last|
+methodListView notNil ifTrue:[
+	currentMethodCategory notNil ifTrue:[
+	    fullProtocol ifTrue:[
+		selectors := self listOfAllSelectorsInCategory:currentMethodCategory
+					    inFullProtocolHierarchyOfClass:actualClass
+	    ] ifFalse:[
+		selectors := self listOfAllSelectorsInCategory:currentMethodCategory
+						       ofClass:actualClass
+	    ]
+	].
+	scr := scroll.
+	first := methodListView firstLineShown.
+	first ~~ 1 ifTrue:[
+	    last := methodListView lastLineShown.
+	    selectors size <= (last - first + 1) ifTrue:[
+		scr := true
+	    ]
+	].
+	methodListView list = selectors ifFalse:[
+	    scr ifTrue:[
+		methodListView contents:selectors
+	    ] ifFalse:[
+		methodListView setContents:selectors
+	    ]
+	].
+]
+!
+methodSelectionChanged
+"method selection has changed - update dependent views"
+self withWaitCursorDo:[
+	|index cls|
+	self updateCodeView.
+	self setAcceptAndExplainActionsForMethod.
+	"
+	 if there is any autoSearch string, do the search
+	"
+	autoSearch notNil ifTrue:[
+	    codeView searchFwd:autoSearch ifAbsent:[]
+	].
+	fullProtocol ifTrue:[
+	    "
+	     remove any bold attribute from classList
+	    "
+	    1 to:classListView list size do:[:i |
+		classListView attributeAt:i remove:#bold.
+	    ].
+	    "
+	     boldify the class where this method is implemented
+	    "
+	    currentMethod notNil ifTrue:[
+		cls := currentMethod who at:1.
+		index := classListView list indexOf:(cls name).
+		index ~~ 0 ifTrue:[
+		    classListView attributeAt:index add:#bold.
+		].
+		currentClass := cls.
+	    ]
+	].
+]
+!
+updateMethodList
+self updateMethodListWithScroll:true
+!
+methodSelection:lineNr
+"user clicked on a method line - show code"
+|selectorString selectorSymbol index|
+(fullProtocol not and:[currentClass isNil]) ifTrue:[^ self].
+selectorString := methodListView selectionValue.
+"
+kludge: check if its a wrapped one
+"
+(selectorString endsWith:' !!') ifTrue:[
+	selectorString := selectorString copyTo:(selectorString size - 2)
+].
+selectorSymbol := selectorString asSymbol.
+fullProtocol ifTrue:[
+	currentMethod := currentSelector := nil.
+	"
+	 search which class implements the selector
+	"
+	self classesInFullProtocolHierarchy:actualClass do:[:c |
+	    (currentMethod isNil
+	     and:[c implements:selectorSymbol]) ifTrue:[
+		currentSelector := selectorSymbol.
+		currentMethod := c compiledMethodAt:selectorSymbol.
+	    ]
+	]
+] ifFalse:[
+	currentSelector := selectorSymbol.
+	currentMethod := actualClass compiledMethodAt:selectorSymbol.
+].
+methodCategoryListView notNil ifTrue:[
+	currentMethod notNil ifTrue:[
+	    (currentMethodCategory = currentMethod category) ifFalse:[
+		currentMethodCategory := currentMethod category.
+		methodCategoryListView selectElement:currentMethodCategory
+	    ]
+	]
+].
+self methodSelectionChanged
+!
+listOfAllSelectorsInCategory:aCategory ofClass:aClass
+"answer a list of all selectors in a given method category
+of the argument, aClass"
+|newList searchCategory selector|
+(aCategory = '* all *') ifTrue:[
+	newList := aClass selectorArray asOrderedCollection
+] ifFalse:[
+	(aCategory = '* no category *') ifTrue:[
+	    searchCategory := nil
+	] ifFalse:[
+	    searchCategory := aCategory
+	].
+	newList := OrderedCollection new.
+	aClass methodArray with:aClass selectorArray do:[:aMethod :selector |
+	    |sel|
+	    (aMethod category = searchCategory) ifTrue:[
+		aMethod isWrapped ifTrue:[
+		    sel := selector , ' !!'
+		] ifFalse:[
+		    sel := selector
+		].
+		"mhmh - can this happen ?"
+"/                (newList includes:sel) ifFalse:[
+		    newList add:sel
+"/                ]
+	    ]
+	]
+].
+(newList size == 0) ifTrue:[^ nil].
+^ newList sort
+!
+template
+"return a method definition template"
+^
+'message selector and argument names
+"comment stating purpose of message"
+|temporaries|
+statements
+"
+change above template into real code.
+Then ''accept'' either via the menu
+or via the keyboard (usually CMD-A).
+You do not need this template; you can also
+select any existing methods code, change it,
+and finally ''accept''.
+"
+'
+!
+listOfAllSelectorsInCategory:aCategory inFullProtocolHierarchyOfClass:aClass
+"answer a list of all selectors in a given method category
+of the argument, aClass and its superclasses.
+Used with fullProtocol browsing."
+|newList thisList searchCategory selector|
+newList := Set new.
+self classesInFullProtocolHierarchy:aClass do:[:c |
+	(aCategory = '* all *') ifTrue:[
+	    newList addAll:(c selectorArray)
+	] ifFalse:[
+	    (aCategory = '* no category *') ifTrue:[
+		searchCategory := nil
+	    ] ifFalse:[
+		searchCategory := aCategory
+	    ].
+	    c methodArray with:c selectorArray do:[:aMethod :selector |
+		(aMethod category = searchCategory) ifTrue:[
+		    newList add:selector
+		]
+	    ]
+	].
+].
+(newList size == 0) ifTrue:[^ nil].
+^ newList asOrderedCollection sort
+!
+checkMethodSelected
+currentMethod isNil ifTrue:[
+	self warn:'select a method first'.
+	^ false
+].
+^ true
+!
+switchToMethodNamed:matchString
+|aSelector method cat index classToSearch selectors|
+currentClass notNil ifTrue:[
+	showInstance ifTrue:[
+	    classToSearch := currentClass
+	] ifFalse:[
+	    classToSearch := currentClass class
+	].
+	selectors := classToSearch selectorArray.
+	((matchString ~= '*') and:[matchString includesMatchCharacters]) ifTrue:[
+	    index := selectors findFirst:[:element | matchString match:element]
+	] ifFalse:[
+	    index := selectors indexOf:matchString
+	].
+	(index ~~ 0) ifTrue:[
+	    aSelector := selectors at:index.
+	    method := classToSearch methodArray at:index.
+	    cat := method category.
+	    cat isNil ifTrue:[cat := '* all *'].
+	    methodCategoryListView selectElement:cat.
+	    currentMethodCategory := cat.
+	    self methodCategorySelectionChanged.
+	    currentMethod := classToSearch compiledMethodAt:aSelector.
+	    currentMethod notNil ifTrue:[
+		currentSelector := aSelector.
+		methodListView selectElement:aSelector.
+	    ].
+	    self methodSelectionChanged
+	]
+]
+!
+switchToAnyMethodNamed:aString
+|aSelector classToStartSearch aClass nm|
+aSelector := aString asSymbol.
+currentClass isNil ifTrue:[
+	currentClassHierarchy notNil ifTrue:[
+	    classToStartSearch := currentClassHierarchy
+	]
+] ifFalse:[
+	classToStartSearch := currentClass
+].
+classToStartSearch notNil ifTrue:[
+	showInstance ifFalse:[
+	    classToStartSearch := classToStartSearch class
+	].
+	aClass := classToStartSearch whichClassImplements:aSelector.
+	aClass notNil ifTrue:[
+	    nm := aClass name.
+	    showInstance ifFalse:[
+		((nm ~= 'Metaclass') and:[nm endsWith:'class']) ifTrue:[
+		    nm := nm copyTo:(nm size - 5)
+		]
+	    ].
+	    self switchToClassNamed:nm.
+	    self switchToMethodNamed:aString
+	]
+]
+! !
+!SystemBrowser methodsFor:'misc'!
+updateCodeView
+|code aStream|
+fullClass ifTrue:[
+	currentClass notNil ifTrue:[
+	    code := currentClass source.
+	]
+] ifFalse:[
+	currentMethod notNil ifTrue:[
+	    (codeView acceptAction isNil
+	    and:[actualClass notNil
+	    and:[currentMethodCategory notNil]]) ifTrue:[
+		self setAcceptAndExplainActionsForMethod.
+	    ].
+	    code := currentMethod source.
+	]
+].
+codeView contents:code.
+codeView modified:false.
+self normalLabel.
+!
+instanceProtocol
+"switch to instance protocol"
+showInstance ifFalse:[
+	self checkSelectionChangeAllowed ifTrue:[
+	    classToggle turnOff.
+	    instanceToggle turnOn.
+	    showInstance := true.
+	    (variableListView notNil
+	    and:[variableListView hasSelection]) ifTrue:[
+		self unhilightMethodCategories.
+		self unhilightMethods.
+		variableListView deselect
+	    ].
+	    fullProtocol ifTrue:[
+		actualClass := currentClass.
+		self updateClassList.
+		self updateMethodCategoryListWithScroll:false.
+		self updateMethodListWithScroll:false.
+		self updateVariableList.
+		^ self
+	    ].
+	    currentClass notNil ifTrue:[
+		self classSelectionChanged
+	    ].
+	    codeView modified:false.
+	] ifFalse:[
+	    instanceToggle turnOff.
+	    classToggle turnOn
+	]
+]
+!
+classProtocol
+"switch to class protocol"
+showInstance ifTrue:[
+	self checkSelectionChangeAllowed ifTrue:[
+	    instanceToggle turnOff.
+	    classToggle turnOn.
+	    showInstance := false.
+	    (variableListView notNil
+	    and:[variableListView hasSelection]) ifTrue:[
+		self unhilightMethodCategories.
+		self unhilightMethods.
+		variableListView deselect
+	    ].
+	    fullProtocol ifTrue:[
+		actualClass := currentClass class.
+		self updateClassList.
+		self updateMethodCategoryListWithScroll:false.
+		self updateMethodListWithScroll:false.
+		self updateVariableList.
+		^ self
+	    ].
+	    currentClass notNil ifTrue:[
+		self classSelectionChanged
+	    ].
+	    codeView modified:false.
+	] ifFalse:[
+	    instanceToggle turnOn.
+	    classToggle turnOff
+	]
+]
+! !
+!SystemBrowser methodsFor:'method category stuff'!
+updateMethodCategoryListWithScroll:scroll
+|categories|
+methodCategoryListView notNil ifTrue:[
+	fullProtocol ifTrue:[
+	    currentClassHierarchy notNil ifTrue:[
+		categories := self listOfAllMethodCategoriesInFullProtocolHierarchy:currentClassHierarchy
+	    ]
+	] ifFalse:[
+	    currentClass notNil ifTrue:[
+		categories := self listOfAllMethodCategoriesInClass:actualClass
+	    ]
+	].
+	methodCategoryListView list = categories ifFalse:[
+	    scroll ifTrue:[
+		methodCategoryListView contents:categories
+	    ] ifFalse:[
+		methodCategoryListView setContents:categories
+	    ].
+	    currentMethodCategory notNil ifTrue:[
+		methodCategoryListView selectElement:currentMethodCategory
+	    ]
+	]
+]
+!
+listOfAllMethodCategoriesInClass:aClass
+"answer a list of all method categories of the argument, aClass"
+|newList cat|
+newList := Text new.
+aClass methodArray do:[:aMethod |
+	cat := aMethod category.
+	cat isNil ifTrue:[
+	    cat := '* no category *'
+	].
+	(newList includes:cat) ifFalse:[newList add:cat]
+].
+(newList size == 0) ifTrue:[^ nil].
+newList add:'* all *'.
+^ newList sort
+!
+methodCategorySelection:lineNr
+"user clicked on a method category line - show selectors"
+|oldSelector|
+oldSelector := currentSelector.
+(fullProtocol not and:[currentClass isNil]) ifTrue:[^ self].
+currentMethodCategory := methodCategoryListView selectionValue.
+self methodCategorySelectionChanged.
+"if there is only one method, show it right away"
+methodListView list size == 1 ifTrue:[
+	methodListView selection:1.
+	self methodSelection:1
+] ifFalse:[
+	oldSelector notNil ifTrue:[
+	    methodListView selectElement:oldSelector.
+	    methodListView selection notNil ifTrue:[
+		self methodSelection:methodListView selection.
+	    ]
+	]
+]
+!
+updateMethodCategoryList
+self updateMethodCategoryListWithScroll:true
+!
+methodCategorySelectionChanged
+"method category selection has changed - update dependant views"
+self withWaitCursorDo:[
+	currentMethod := currentSelector := nil.
+	self updateMethodList.
+	self updateCodeView.
+	currentMethodCategory notNil ifTrue:[
+	    methodCategoryListView selectElement:currentMethodCategory
+	].
+	self setAcceptAndExplainActionsForMethod.
+	self hilightMethodsInMethodCategoryList:false inMethodList:true.
+]
+!
+listOfAllMethodCategoriesInFullProtocolHierarchy:aClass
+"answer a list of all method categories of the argument, aClass,
+and all of its superclasses.
+Used with fullProtocol browsing."
+|newList cat|
+newList := Text new.
+self classesInFullProtocolHierarchy:aClass do:[:c |
+	c methodArray do:[:aMethod |
+	    cat := aMethod category.
+	    cat isNil ifTrue:[
+		cat := '* no category *'
+	    ].
+	    (newList includes:cat) ifFalse:[newList add:cat]
+	]
+].
+(newList size == 0) ifTrue:[^ nil].
+newList add:'* all *'.
+^ newList sort
+!
+checkMethodCategorySelected
+currentMethodCategory isNil ifTrue:[
+	self warn:'select a method category first'.
+	^ false
+].
+^ true
+!
+whenMethodCategorySelected:aBlock
+self checkMethodCategorySelected ifTrue:[
+	self withWaitCursorDo:aBlock
+]
+!
+copyMethodsFromClass:aClassName
+|class box|
+currentClass notNil ifTrue:[
+	Symbol hasInterned:aClassName ifTrue:[:sym |
+	    (Smalltalk includesKey:sym) ifTrue:[
+		class := Smalltalk at:sym
+	    ].
+	].
+	class isBehavior ifFalse:[
+	    self warn:'no class named %1' with:aClassName.
+	    ^ self
+	].
+	showInstance ifFalse:[
+	    class := class class
+	].
+	"show enterbox for category to copy from"
+	box := self enterBoxTitle:'name of category to copy from (matchpattern allowed, * for all):'
+			   okText:'copy'.
+	box action:[:aString | self copyMethodsFromClass:class category:aString].
+	box showAtPointer.
+]
+!
+copyMethodsFromClass:class category:category
+|source|
+currentClass notNil ifTrue:[
+"/        codeView abortAction:[^ self].
+	Object abortSignal catch:[
+	    class methodArray do:[:aMethod |
+		(category match:aMethod category) ifTrue:[
+		    source := aMethod source.
+		    codeView contents:source.
+		    codeView modified:false.
+		    actualClass compiler compile:source
+					forClass:actualClass
+				      inCategory:aMethod category
+				       notifying:codeView.
+		    self updateMethodCategoryListWithScroll:false.
+		    self updateMethodListWithScroll:false.
+		]
+	    ]
+	]
+]
+!
+newMethodCategory:aString
+|categories|
+currentClass isNil ifTrue:[
+	^ self warn:'select/create a class first'.
+].
+categories := methodCategoryListView list.
+categories isNil ifTrue:[categories := Text new].
+(categories includes:aString) ifFalse:[
+	categories add:aString.
+	categories sort.
+	methodCategoryListView contents:categories
+].
+currentMethodCategory := aString.
+self methodCategorySelectionChanged
 ! !
 !SystemBrowser methodsFor:'initialize / release'!
 initialize
 self icon:(Form fromFile:(resources at:'ICON_FILE' default:'SBrowser.xbm')
 		  resolution:100).
 showInstance := true.
 fullClass := false.
+fullProtocol := false.
 aspect := nil.
 "inform me, when Smalltalk changes"
 Smalltalk addDependent:self
+!
+realize
+|v checkBlock|
+super realize.
+checkBlock := [:lineNr | self checkSelectionChangeAllowed].
+v := classCategoryListView.
+v notNil ifTrue:[
+	v action:[:lineNr | self classCategorySelection:lineNr].
+	v selectConditionBlock:checkBlock.
+	v ignoreReselect:false.
+	v contents:(self listOfAllClassCategories).
+	self initializeClassCategoryMenu
+].
+v := classListView.
+v notNil ifTrue:[
+	v action:[:lineNr | self classSelection:lineNr].
+	v selectConditionBlock:checkBlock.
+	v ignoreReselect:false.
+	self initializeClassMenu
+].
+v := methodCategoryListView.
+v notNil ifTrue:[
+	v action:[:lineNr | self methodCategorySelection:lineNr].
+	v selectConditionBlock:checkBlock.
+	v ignoreReselect:false.
+	self initializeMethodCategoryMenu
+].
+v := methodListView.
+v notNil ifTrue:[
+	v action:[:lineNr | self methodSelection:lineNr].
+	v selectConditionBlock:checkBlock.
+	v ignoreReselect:false.
+	self initializeMethodMenu
+].
+v := classMethodListView.
+v notNil ifTrue:[
+	v action:[:lineNr | self classMethodSelection:lineNr].
+	v selectConditionBlock:checkBlock.
+	v ignoreReselect:false.
+	self initializeClassMethodMenu
+].
+v := variableListView.
+v notNil ifTrue:[
+	v action:[:lineNr | self variableSelection:lineNr].
+	v ignoreReselect:false.
+	v toggleSelect:true
+]
+!
+terminate
+(self checkSelectionChangeAllowed) ifTrue:[
+	super terminate
+]
 !
 destroy
 "relese dependant - destroy popups"
 	currentClass := nil
 ].
 super destroy
 !
-terminate
+autoSearch:aString
-(self checkSelectionChangeAllowed) ifTrue:[
+"used with class-method list browsing. If true,
-	super terminate
+selecting an entry from the list will automatically
-]
+search for the searchstring in the codeView"
-!
+self setSearchPattern:aString.
-createTogglesIn:aFrame
+autoSearch := aString
-"create and setup the class/instance toggles"
+!
-|halfSpacing h|
+title:someString
+myLabel := someString.
-instanceToggle := Toggle label:(resources at:'instance') in:aFrame.
+self label:someString.
-h := instanceToggle height.
-instanceToggle origin:(0.0 @ 1.0) corner:(0.5 @ 1.0).
+! !
-instanceToggle topInset:(h negated).
+!SystemBrowser methodsFor:'initialize subviews'!
-instanceToggle turnOn.
-instanceToggle pressAction:[self instanceProtocol].
-instanceToggle releaseAction:[self classProtocol].
-classToggle := Toggle label:(resources at:'class') in:aFrame.
-h := classToggle height.
-classToggle origin:(0.5 @ 1.0) corner:(1.0 @ 1.0).
-classToggle topInset:(h negated).
-classToggle turnOff.
-classToggle pressAction:[self classProtocol].
-classToggle releaseAction:[self instanceProtocol].
-StyleSheet is3D ifTrue:[
-	instanceToggle leftInset:(ViewSpacing // 2).
-	classToggle leftInset:(ViewSpacing // 2).
-	instanceToggle rightInset:ViewSpacing - (ViewSpacing // 2).
-	classToggle rightInset:ViewSpacing - (ViewSpacing // 2).
-].
-!
 createClassListViewIn:frame
 "setup the classlist subview, with its toggles"
 |v panel oldStyle|
 			      - instanceToggle borderWidth
 			      + v borderWidth)]
 			in:frame.
 	v := ScrollableView for:SelectionInListView in:panel.
-	v origin:(0.0 @ 0.0) corner:(1.0 @ 0.5).
+	v origin:(0.0 @ 0.0) corner:(1.0 @ 0.7).
 	classListView := v scrolledView.
 	v := ScrollableView for:SelectionInListView in:panel.
-	v origin:(0.0 @ 0.5)
+	v origin:(0.0 @ 0.7)
 	  corner:(1.0 @ 1.0).
 	variableListView := v scrolledView
 ]
+!
+createCodeViewIn:aView at:relY
+"setup the code view"
+|v|
+v := HVScrollableView for:CodeView miniScrollerH:true miniScrollerV:false in:aView.
+v origin:(0.0 @ relY) corner:(1.0 @ 1.0).
+codeView := v scrolledView
+!
+createTogglesIn:aFrame
+"create and setup the class/instance toggles"
+|halfSpacing h classAction instanceAction|
+classAction := [self classProtocol].
+instanceAction := [self instanceProtocol].
+instanceToggle := Toggle label:(resources at:'instance') in:aFrame.
+h := instanceToggle height.
+instanceToggle origin:(0.0 @ 1.0) corner:(0.5 @ 1.0).
+instanceToggle topInset:(h negated).
+instanceToggle turnOn.
+instanceToggle pressAction:instanceAction.
+instanceToggle releaseAction:classAction.
+classToggle := Toggle label:(resources at:'class') in:aFrame.
+h := classToggle height.
+classToggle origin:(0.5 @ 1.0) corner:(1.0 @ 1.0).
+classToggle topInset:(h negated).
+classToggle turnOff.
+classToggle pressAction:classAction.
+classToggle releaseAction:instanceAction.
+StyleSheet is3D ifTrue:[
+	instanceToggle leftInset:(ViewSpacing // 2).
+	classToggle leftInset:(ViewSpacing // 2).
+	instanceToggle rightInset:ViewSpacing - (ViewSpacing // 2).
+	classToggle rightInset:ViewSpacing - (ViewSpacing // 2).
+].
 !
 createCodeViewIn:aView
 "setup the code view"
-|v|
+^ self createCodeViewIn:aView at:0.25
-v := HVScrollableView for:CodeView miniScrollerH:true miniScrollerV:false in:aView.
+!
-v origin:(0.0 @ 0.25) corner:(1.0 @ 1.0).
-codeView := v scrolledView
+setupForList:aList
-!
+"setup subviews to browse methods from a list"
-setupActions
+|vpanel v|
-"/    |v|
+vpanel := VariableVerticalPanel
-"/    v := classCategoryListView.
+			origin:(0.0 @ 0.0)
-"/    v notNil ifTrue:[
+			corner:(1.0 @ 1.0)
-"/        v action:[:lineNr | self classCategorySelection:lineNr].
+			    in:self.
-"/        v selectConditionBlock:[self checkSelectionChangeAllowed].
-"/        v ignoreReselect:false.
+v := ScrollableView for:SelectionInListView in:vpanel.
-"/    ].
+v origin:(0.0 @ 0.0) corner:(1.0 @ 0.25).
-"/    v := classListView.
+classMethodListView := v scrolledView.
-"/    v notNil ifTrue:[
+classMethodListView contents:aList.
-"/        v action:[:lineNr | self classSelection:lineNr].
-"/        v selectConditionBlock:[self checkSelectionChangeAllowed].
+self createCodeViewIn:vpanel.
-"/        v ignoreReselect:false.
+self updateCodeView
-"/    ].
-"/    v := methodCategoryListView.
-"/    v notNil ifTrue:[
-"/        v action:[:lineNr | self methodCategorySelection:lineNr].
-"/        v selectConditionBlock:[self checkSelectionChangeAllowed].
-"/        v ignoreReselect:false.
-"/    ].
-"/    v := methodListView.
-"/    v notNil ifTrue:[
-"/        v action:[:lineNr | self methodSelection:lineNr].
-"/        v selectConditionBlock:[self checkSelectionChangeAllowed].
-"/        v ignoreReselect:false.
-"/    ].
-"/    v := classMethodListView.
-"/    v notNil ifTrue:[
-"/        v action:[:lineNr | self listSelection:lineNr].
-"/        v selectConditionBlock:[self checkSelectionChangeAllowed].
-"/        v ignoreReselect:false.
-"/    ]
 !
 setupForAll
 "create subviews for a full browser"
 v := HVScrollableView for:SelectionInListView
 			  miniScrollerH:true miniScrollerV:false
 			  in:hpanel.
 v origin:(0.0 @ 0.0) corner:(0.25 @ 1.0).
 classCategoryListView := v scrolledView.
-"/    classCategoryListView contents:(self listOfAllClassCategories).
 frame := View origin:(0.25 @ 0.0) corner:(0.5 @ 1.0) in:hpanel.
 self createClassListViewIn:frame.
 v := HVScrollableView for:SelectionInListView miniScrollerH:true miniScrollerV:false in:hpanel.
 v := HVScrollableView for:SelectionInListView miniScrollerH:true miniScrollerV:false in:hpanel.
 v origin:(0.75 @ 0.0) corner:(1.0 @ 1.0).
 methodListView := v scrolledView.
-"/    self setupActions.
 self createCodeViewIn:vpanel
+!
+setupForClassHierarchy:aClass
+"setup subviews to browse a class hierarchy"
+|vpanel hpanel frame v|
+vpanel := VariableVerticalPanel origin:(0.0 @ 0.0)
+				    corner:(1.0 @ 1.0)
+					in:self.
+"
+notice: we use a different ratio here
+"
+hpanel := View origin:(0.0 @ 0.0) corner:(1.0 @ 0.4) in:vpanel.
+frame := View origin:(0.0 @ 0.0) corner:(0.33 @ 1.0) in:hpanel.
+self createClassListViewIn:frame.
+v := ScrollableView for:SelectionInListView in:hpanel.
+v origin:(0.33 @ 0.0) corner:(0.66 @ 1.0).
+methodCategoryListView := v scrolledView.
+v := ScrollableView for:SelectionInListView in:hpanel.
+v origin:(0.66 @ 0.0) corner:(1.0 @ 1.0).
+methodListView := v scrolledView.
+self createCodeViewIn:vpanel at:0.4.
+currentClassHierarchy := aClass.
+self updateClassList.
+self updateMethodCategoryList.
+self updateMethodList.
+self updateCodeView
 !
 setupForFullClass
 "setup subviews to browse a class as full text"
 v := ScrollableView for:SelectionInListView in:hpanel.
 v origin:(0.5 @ 0.0) corner:(1.0 @ 1.0).
 classListView := v scrolledView.
-"/    self setupActions.
 self createCodeViewIn:vpanel.
 fullClass := true.
-self updateCodeView
-!
-setupForClassCategory:aClassCategory
-"setup subviews to browse a class category"
-|vpanel hpanel frame v|
-vpanel := VariableVerticalPanel origin:(0.0 @ 0.0)
-				    corner:(1.0 @ 1.0)
-					in:self.
-hpanel := View origin:(0.0 @ 0.0) corner:(1.0 @ 0.25) in:vpanel.
-frame  := View origin:(0.0 @ 0.0) corner:(0.33 @ 1.0) in:hpanel.
-self createClassListViewIn:frame.
-v := ScrollableView for:SelectionInListView in:hpanel.
-v origin:(0.33 @ 0.0) corner:(0.66 @ 1.0).
-methodCategoryListView := v scrolledView.
-v := ScrollableView for:SelectionInListView in:hpanel.
-v origin:(0.66 @ 0.0) corner:(1.0 @ 1.0).
-methodListView := v scrolledView.
-"/    self setupActions.
-self createCodeViewIn:vpanel.
-currentClassCategory := aClassCategory.
-self updateClassList.
-self updateMethodCategoryList.
-self updateMethodList.
-self updateCodeView
-!
-setupForClassList:aList
-"setup subviews to browse classes from a list"
-|vpanel hpanel frame l v|
-vpanel := VariableVerticalPanel
-		 origin:(0.0 @ 0.0) corner:(1.0 @ 1.0) in:self.
-hpanel := View origin:(0.0 @ 0.0) corner:(1.0 @ 0.25) in:vpanel.
-frame := View origin:(0.0 @ 0.0) corner:(0.33 @ 1.0) in:hpanel.
-self createClassListViewIn:frame.
-v := ScrollableView for:SelectionInListView in:hpanel.
-v origin:(0.33 @ 0.0) corner:(0.66 @ 1.0).
-methodCategoryListView := v scrolledView.
-v := ScrollableView for:SelectionInListView in:hpanel.
-v origin:(0.66 @ 0.0) corner:(1.0 @ 1.0).
-methodListView := v scrolledView.
-"/    self setupActions.
-self createCodeViewIn:vpanel.
-l := aList collect:[:entry | entry name].
-classListView list:(l sort).
-self updateMethodCategoryList.
-self updateMethodList.
-self updateCodeView
-!
-setupForClassHierarchy:aClass
-"setup subviews to browse a class hierarchy"
-|vpanel hpanel frame v|
-vpanel := VariableVerticalPanel origin:(0.0 @ 0.0)
-				    corner:(1.0 @ 1.0)
-					in:self.
-hpanel := View origin:(0.0 @ 0.0) corner:(1.0 @ 0.25) in:vpanel.
-frame := View origin:(0.0 @ 0.0) corner:(0.33 @ 1.0) in:hpanel.
-self createClassListViewIn:frame.
-v := ScrollableView for:SelectionInListView in:hpanel.
-v origin:(0.33 @ 0.0) corner:(0.66 @ 1.0).
-methodCategoryListView := v scrolledView.
-v := ScrollableView for:SelectionInListView in:hpanel.
-v origin:(0.66 @ 0.0) corner:(1.0 @ 1.0).
-methodListView := v scrolledView.
-"/    self setupActions.
-self createCodeViewIn:vpanel.
-currentClassHierarchy := aClass.
-self updateClassList.
-self updateMethodCategoryList.
-self updateMethodList.
 self updateCodeView
 !
 setupForClass:aClass
 "create subviews for browsing a single class"
 v := ScrollableView for:SelectionInListView in:hpanel.
 v origin:(0.5 @ 0.0) corner:(1.0 @ 1.0).
 methodListView := v scrolledView.
-"/    self setupActions.
 self createCodeViewIn:vpanel.
 self switchToClass:aClass.
 actualClass := aClass.
 self updateMethodCategoryList.
 self updateMethodList.
 self updateCodeView
 !
+setupForClassCategory:aClassCategory
+"setup subviews to browse a class category"
+|vpanel hpanel frame v|
+vpanel := VariableVerticalPanel origin:(0.0 @ 0.0)
+				    corner:(1.0 @ 1.0)
+					in:self.
+hpanel := View origin:(0.0 @ 0.0) corner:(1.0 @ 0.25) in:vpanel.
+frame  := View origin:(0.0 @ 0.0) corner:(0.33 @ 1.0) in:hpanel.
+self createClassListViewIn:frame.
+v := ScrollableView for:SelectionInListView in:hpanel.
+v origin:(0.33 @ 0.0) corner:(0.66 @ 1.0).
+methodCategoryListView := v scrolledView.
+v := ScrollableView for:SelectionInListView in:hpanel.
+v origin:(0.66 @ 0.0) corner:(1.0 @ 1.0).
+methodListView := v scrolledView.
+self createCodeViewIn:vpanel.
+currentClassCategory := aClassCategory.
+self updateClassList.
+self updateMethodCategoryList.
+self updateMethodList.
+self updateCodeView
+!
+setupForClass:aClass selector:selector
+"setup subviews to browse a single method"
+|v|
+v := ScrollableView for:CodeView in:self.
+v origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+codeView := v scrolledView.
+currentClassCategory := aClass category.
+self switchToClass:aClass.
+actualClass := aClass.
+currentSelector := selector.
+currentMethod := currentClass compiledMethodAt:selector.
+currentMethodCategory := currentMethod category.
+self updateCodeView
+!
+setupForClassList:aList
+"setup subviews to browse classes from a list"
+|vpanel hpanel frame l v|
+vpanel := VariableVerticalPanel
+		 origin:(0.0 @ 0.0) corner:(1.0 @ 1.0) in:self.
+hpanel := View origin:(0.0 @ 0.0) corner:(1.0 @ 0.25) in:vpanel.
+frame := View origin:(0.0 @ 0.0) corner:(0.33 @ 1.0) in:hpanel.
+self createClassListViewIn:frame.
+v := ScrollableView for:SelectionInListView in:hpanel.
+v origin:(0.33 @ 0.0) corner:(0.66 @ 1.0).
+methodCategoryListView := v scrolledView.
+v := ScrollableView for:SelectionInListView in:hpanel.
+v origin:(0.66 @ 0.0) corner:(1.0 @ 1.0).
+methodListView := v scrolledView.
+self createCodeViewIn:vpanel.
+l := aList collect:[:entry | entry name].
+classListView list:(l sort).
+self updateMethodCategoryList.
+self updateMethodList.
+self updateCodeView
+!
 setupForClass:aClass methodCategory:aMethodCategory
 "setup subviews to browse a method category"
 |vpanel v|
 v := ScrollableView for:SelectionInListView in:vpanel.
 v origin:(0.0 @ 0.0) corner:(1.0 @ 0.25).
 methodListView := v scrolledView.
-"/    self setupActions.
 self createCodeViewIn:vpanel.
 currentClassCategory := aClass category.
 self switchToClass:aClass.
 actualClass := aClass.
 currentMethodCategory := aMethodCategory.
 self updateMethodList.
 self updateCodeView
 !
-setupForClass:aClass selector:selector
+setupForFullClassProtocol:aClass
-"setup subviews to browse a single method"
+"setup subviews to browse a classes full protocol"
-|v|
+|vpanel hpanel frame v|
-v := ScrollableView for:CodeView in:self.
+vpanel := VariableVerticalPanel origin:(0.0 @ 0.0)
-v origin:(0.0 @ 0.0) corner:(1.0 @ 1.0).
+				    corner:(1.0 @ 1.0)
-codeView := v scrolledView.
+					in:self.
-currentClassCategory := aClass category.
+"
-self switchToClass:aClass.
+notice: we use a different ratio here
-actualClass := aClass.
+"
-currentMethod := currentClass compiledMethodAt:selector.
+hpanel := View origin:(0.0 @ 0.0) corner:(1.0 @ 0.4) in:vpanel.
-currentMethodCategory := currentMethod category.
+frame := View origin:(0.0 @ 0.0) corner:(0.33 @ 1.0) in:hpanel.
-self updateCodeView
-!
+self createClassListViewIn:frame.
+classListView multipleSelectOk:true.
-setupForList:aList
+classListView toggleSelect:true.
-"setup subviews to browse methods from a list"
+classListView strikeOut:true.
-|vpanel v|
+v := ScrollableView for:SelectionInListView in:hpanel.
+v origin:(0.33 @ 0.0) corner:(0.66 @ 1.0).
-vpanel := VariableVerticalPanel
+methodCategoryListView := v scrolledView.
-			origin:(0.0 @ 0.0)
-			corner:(1.0 @ 1.0)
+v := ScrollableView for:SelectionInListView in:hpanel.
-			    in:self.
+v origin:(0.66 @ 0.0) corner:(1.0 @ 1.0).
+methodListView := v scrolledView.
-v := ScrollableView for:SelectionInListView in:vpanel.
-v origin:(0.0 @ 0.0) corner:(1.0 @ 0.25).
+self createCodeViewIn:vpanel at:0.4.
-classMethodListView := v scrolledView.
-classMethodListView contents:aList.
+currentClassHierarchy := actualClass := currentClass := aClass.
+fullProtocol := true.
+self updateClassList.
+self updateMethodCategoryList.
+self updateMethodList.
+self updateCodeView.
+self updateVariableList.
+!
+setupForFullClassHierarchy:aClass
+"setup subviews to browse a class hierarchy"
+|vpanel hpanel frame v|
+vpanel := VariableVerticalPanel origin:(0.0 @ 0.0)
+				    corner:(1.0 @ 1.0)
+					in:self.
+hpanel := View origin:(0.0 @ 0.0) corner:(1.0 @ 0.4) in:vpanel.
+frame := View origin:(0.0 @ 0.0) corner:(0.33 @ 1.0) in:hpanel.
+self createClassListViewIn:frame.
+classListView multipleSelectOk:true.
+classListView toggleSelect:true.
+classListView strikeOut:true.
+v := ScrollableView for:SelectionInListView in:hpanel.
+v origin:(0.33 @ 0.0) corner:(0.66 @ 1.0).
+methodCategoryListView := v scrolledView.
+v := ScrollableView for:SelectionInListView in:hpanel.
+v origin:(0.66 @ 0.0) corner:(1.0 @ 1.0).
+methodListView := v scrolledView.
 "/    self setupActions.
-self createCodeViewIn:vpanel.
+self createCodeViewIn:vpanel at:0.4.
-self updateCodeView
+currentClassHierarchy := actualClass := aClass.
+fullProtocol := true.
+self updateClassList.
+self updateMethodCategoryList.
+self updateMethodList.
+self updateCodeView.
+self updateVariableList.
 ! !
-!SystemBrowser methodsFor:'realization'!
+!SystemBrowser methodsFor:'unused'!
-realize
+listOfAllSelectorsInCategory:aCategory inHierarchyOfClass:aClass
-|v checkBlock|
+"answer a list of all selectors in a given method category
+of the argument, aClass and its superclasses"
-super realize.
+|newList thisList searchCategory selector|
-checkBlock := [:lineNr | self checkSelectionChangeAllowed].
+newList := Set new.
-v := classCategoryListView.
+self classesInHierarchy:aClass do:[:c |
-v notNil ifTrue:[
+	(aCategory = '* all *') ifTrue:[
-	v action:[:lineNr | self classCategorySelection:lineNr].
+	    newList addAll:(c selectorArray)
-	v selectConditionBlock:checkBlock.
+	] ifFalse:[
-	v ignoreReselect:false.
+	    (aCategory = '* no category *') ifTrue:[
-	v contents:(self listOfAllClassCategories).
+		searchCategory := nil
-	self initializeClassCategoryMenu
+	    ] ifFalse:[
-].
+		searchCategory := aCategory
+	    ].
-v := classListView.
+	    c methodArray with:c selectorArray do:[:aMethod :selector |
-v notNil ifTrue:[
+		(aMethod category = searchCategory) ifTrue:[
-	v action:[:lineNr | self classSelection:lineNr].
+		    newList add:selector
-	v selectConditionBlock:checkBlock.
+		]
-	v ignoreReselect:false.
+	    ]
-	self initializeClassMenu
+	].
 ].
+(newList size == 0) ifTrue:[^ nil].
-v := methodCategoryListView.
+^ newList asOrderedCollection sort
-v notNil ifTrue:[
+!
-	v action:[:lineNr | self methodCategorySelection:lineNr].
-	v selectConditionBlock:checkBlock.
+listOfAllMethodCategoriesInHierarchy:aClass
-	v ignoreReselect:false.
+"answer a list of all method categories of the argument, aClass,
-	self initializeMethodCategoryMenu
+and all of its superclasses"
-].
+|newList cat|
-v := methodListView.
-v notNil ifTrue:[
+newList := Text new.
-	v action:[:lineNr | self methodSelection:lineNr].
+self classesInHierarchy:aClass do:[:c |
-	v selectConditionBlock:checkBlock.
+	c methodArray do:[:aMethod |
-	v ignoreReselect:false.
+	    cat := aMethod category.
-	self initializeMethodMenu
+	    cat isNil ifTrue:[
-].
+		cat := '* no category *'
+	    ].
-v := classMethodListView.
+	    (newList includes:cat) ifFalse:[newList add:cat]
-v notNil ifTrue:[
+	]
-	v action:[:lineNr | self listSelection:lineNr].
+].
-	v selectConditionBlock:checkBlock.
+(newList size == 0) ifTrue:[^ nil].
-	v ignoreReselect:false.
+newList add:'* all *'.
-	self initializeClassMethodMenu
+^ newList sort
-]
 ! !
-!SystemBrowser methodsFor:'private'!
+!SystemBrowser methodsFor:'class stuff'!
-checkSelectionChangeAllowed
-"return true, if selection change is ok;
-its not ok, if code has been changed.
-in this case, return the result of a user query"
-|box|
-codeView modified ifFalse:[
-	^ true
-].
-box := YesNoBox
-	       title:(resources at:'contents in codeview has not been accepted.\\Modifications will be lost when continuing.') withCRs
-	       yesText:(resources at:'continue')
-	       noText:(resources at:'abort').
-^ box confirm
-!
 switchToClass:newClass
+fullProtocol ifTrue:[^ self].
 currentClass notNil ifTrue:[
 	currentClass removeDependent:self
 ].
 currentClass := newClass.
 currentClass notNil ifTrue:[
 	currentClass addDependent:self.
 ].
 self normalLabel
 !
-showExplanation:someText
+classSelectionChanged
-"show explanation from Parser"
+|oldMethodCategory oldMethod oldSelector|
-self notify:someText
+self withWaitCursorDo:[
-!
+	oldMethodCategory := currentMethodCategory.
+	oldMethod := currentMethod.
-normalLabel
+	oldSelector := currentSelector.
-"set the normal (inactive) window- and icon labels"
+	showInstance ifTrue:[
-currentClass notNil ifTrue:[
+	    actualClass := currentClass
-	self label:'System Browser: ', currentClass name.
-	self iconLabel:currentClass name
-] ifFalse:[
-	self label:'System Browser'.
-	self iconLabel:'System Browser'.
-]
-!
-setSearchPattern:aString
-codeView setSearchPattern:aString
-!
-selectorToSearchFor
-"look in codeView and methodListView for a search-string when searching for selectors"
-|sel t|
-sel := codeView selection.
-sel notNil ifTrue:[
-	sel := sel asString.
-	t := Parser selectorInExpression:sel.
-	t notNil ifTrue:[
-	    sel := t
-	].
-	sel := sel withoutSpaces
-] ifFalse:[
-	methodListView notNil ifTrue:[
-	    sel := methodListView selectionValue
 	] ifFalse:[
-	    classMethodListView notNil ifTrue:[
+	    actualClass := currentClass class
-		sel := classMethodListView selectionValue.
+	].
-		sel notNil ifTrue:[
+	currentMethodCategory := nil.
-		    sel := self selectorFromClassMethodString:sel
+	currentMethod := nil.
-		]
+	currentSelector := nil.
+	self updateVariableList.
+	self updateMethodCategoryList.
+	oldMethodCategory notNil ifTrue:[
+	    methodCategoryListView selectElement:oldMethodCategory.
+	    methodCategoryListView selection notNil ifTrue:[
+		currentMethodCategory := oldMethodCategory.
+		self methodCategorySelectionChanged
 	    ]
 	].
-	sel notNil ifTrue:[
+	self updateMethodList.
-	    sel := sel withoutSpaces
+	self updateCodeView.
+	fullClass ifTrue:[
+	    codeView acceptAction:[:theCode |
+		codeView cursor:Cursor execute.
+		Object abortSignal catch:[
+		    self compileCode:theCode asString.
+		    codeView modified:false.
+		].
+		codeView cursor:Cursor normal.
+	    ].
 	] ifFalse:[
-	    sel := ''
+	    self classDefinition.
-	]
+	    codeView acceptAction:[:theCode |
-].
+		codeView cursor:Cursor execute.
-^ sel
+		Object abortSignal catch:[
-!
+		    (Compiler evaluate:theCode asString notifying:codeView)
+		    isBehavior ifTrue:[
-stringToSearchFor
+			self classCategoryUpdate.
-"look in codeView and methodListView for a search-string when searching for classes/names"
+			self updateClassListWithScroll:false.
+			codeView modified:false.
-|sel|
+		    ].
+		].
-sel := codeView selection.
+		codeView cursor:Cursor normal.
-sel notNil ifTrue:[
+	    ].
-	sel := sel asString withoutSpaces
+	].
-] ifFalse:[
+	codeView explainAction:nil.
-	sel isNil ifTrue:[
-	    currentClass notNil ifTrue:[
+	classCategoryListView notNil ifTrue:[
-		sel := currentClass name
+	    (currentClassCategory = currentClass category) ifFalse:[
+		currentClassCategory := currentClass category.
+		classCategoryListView selectElement:currentClassCategory
 	    ]
 	].
-	sel notNil ifTrue:[
-	    sel := sel withoutSpaces
+	"set self for doits. This allows accessing the current class
+	 as self, and access to the class variables by name.
+	"
+	codeView doItAction:[:theCode |
+	    |compiler|
+	    currentClass isNil ifTrue:[
+		compiler := Compiler
+	    ] ifFalse:[
+		compiler := currentClass compiler
+	    ].
+	    compiler
+		evaluate:theCode
+		in:nil
+		receiver:currentClass
+		notifying:codeView
+		logged:false
+		ifFail:nil
+	].
+]
+!
+updateClassListWithScroll:scroll
+|classes oldClassName|
+classListView notNil ifTrue:[
+	"
+	 refetch in case we are not up to date
+	"
+	(currentClass notNil and:[fullProtocol not]) ifTrue:[
+	    oldClassName := currentClass name.
+	    currentClass := Smalltalk at:(oldClassName asSymbol).
+	].
+	currentClassCategory notNil ifTrue:[
+	    classes := self listOfAllClassesInCategory:currentClassCategory
 	] ifFalse:[
-	    sel := ''
+	    currentClassHierarchy notNil ifTrue:[
-	]
+		classes := self listOfClassHierarchyOf:currentClassHierarchy
-].
+	    ]
-^ sel
+	].
-!
+	classListView list = classes ifFalse:[
-findClassOfVariable:aVariableName accessWith:aSelector
+	    scroll ifTrue:[
-"this method returns the class, in which a variable
+		classListView contents:classes
-is defined;
+	    ] ifFalse:[
-needs either #instVarNames or #classVarNames as aSelector."
+		classListView setContents:classes
+	    ].
-|cls homeClass|
+	    oldClassName notNil ifTrue:[
+		classListView setContents:classes.
-"
+		classListView selectElement:oldClassName
-first, find the class, where the variable is declared
+	    ] ifFalse:[
-"
+		variableListView notNil ifTrue:[variableListView contents:nil]
-cls := currentClass.
+	    ]
-[cls notNil] whileTrue:[
+	].
-	((cls perform:aSelector) includes:aVariableName) ifTrue:[
+	scroll ifTrue:[
-	    homeClass := cls.
+	    fullProtocol ifTrue:[
-	    cls := nil.
+		classListView scrollToBottom
-	] ifFalse:[
+	    ]
-	    cls := cls superclass
+	]
-	]
+]
-].
+!
-homeClass isNil ifTrue:[
-	"nope, must be one below ... (could optimize a bit, by searching down
+classSelection:lineNr
-	 for the declaring class ...
+"user clicked on a class line - show method categories"
-	"
-	homeClass := currentClass
+|classSymbol cls oldSelector|
-] ifFalse:[
-	Transcript showCr:'starting search in ' , homeClass name.
+(currentClassHierarchy notNil
-].
+and:[fullProtocol]) ifTrue:[
-^ homeClass
+	oldSelector := currentSelector.
-!
+	self updateMethodCategoryListWithScroll:false.
-listBoxTitle:title okText:okText list:aList
+	self updateMethodListWithScroll:false.
-"convenient method: setup a listBox & return it"
+	self updateVariableList.
+	^ self
-|box|
+].
-box := ListSelectionBox new.
+cls := Smalltalk classNamed:classListView selectionValue withoutSpaces.
-box okText:(resources string:okText).
+"
-box title:(resources string:title).
+classSymbol := classListView selectionValue withoutSpaces asSymbol.
-box list:aList.
+(Smalltalk includesKey:classSymbol) ifTrue:[
-^ box
+	cls := Smalltalk at:classSymbol
-!
+].
+"
-enterBoxTitle:title okText:okText
+cls notNil ifTrue:[
-"convenient method: setup enterBox"
+	self switchToClass:cls.
+	self classSelectionChanged
-|box|
+]
-box := EnterBox new.
-box title:(resources string:title) okText:(resources string:okText).
-^ box
-!
-askBoxTitle:title okText:okText initialText:initialText action:aBlock
-"convenient method: setup enterBox, and open it"
-|box|
-box := EnterBox new.
-box title:(resources string:title) okText:(resources string:okText).
-box initialText:initialText.
-box action:[:aString | self withWaitCursorDo:aBlock value:aString].
-box showAtPointer
-!
-enterBoxForSearchSelectorTitle:title
-"convenient method: setup enterBox with text from codeView or selected
-method for browsing based on a selector"
-|box|
-box := self enterBoxTitle:title okText:'search'.
-box initialText:(self selectorToSearchFor).
-^ box
-!
-askAndBrowseSelectorTitle:title action:aBlock
-"convenient method: setup enterBox with text from codeView or selected
-method for browsing based on a selector. Set action and launch box"
-|box|
-box := self enterBoxTitle:title okText:'browse'.
-box initialText:(self selectorToSearchFor).
-box action:[:aString | self withCursor:(Cursor questionMark) do:[aBlock value:aString]].
-box showAtPointer
-!
-enterBoxForBrowseTitle:title action:aBlock
-"convenient method: setup enterBox with text from codeView or selected
-method for method browsing based on className/variable"
-|box|
-box := self enterBoxTitle:title okText:'browse'.
-box initialText:(self stringToSearchFor).
-box action:[:aString | self withWaitCursorDo:[aBlock value:aString]].
-box showAtPointer
-!
-enterBoxForCodeSelectionTitle:title okText:okText
-"convenient method: setup enterBox with text from codeview"
-|sel box|
-box := self enterBoxTitle:(resources string:title) okText:(resources string:okText).
-sel := codeView selection.
-sel notNil ifTrue:[
-	box initialText:(sel asString withoutSeparators)
-].
-^ box
-!
-askAndBrowseMethodCategory:title action:aBlock
-"convenient method: setup enterBox with initial being current method category"
-|sel box|
-box := self enterBoxTitle:title okText:'browse'.
-sel := codeView selection.
-sel isNil ifTrue:[
-	currentMethodCategory notNil ifTrue:[
-	    sel := currentMethodCategory
-	]
-].
-sel notNil ifTrue:[
-	box initialText:(sel asString withoutSpaces)
-].
-box action:[:aString | self withWaitCursorDo:[aBlock value:aString]].
-box showAtPointer
-!
-listOfAllClassCategories
-"return a list of all class categories"
-|newList cat|
-newList := Text with:'* all *' with:'* hierarchy *'.
-Smalltalk allBehaviorsDo:[:aClass |
-	cat := aClass category.
-	cat isNil ifTrue:[
-	    cat := '* no category *'
-	].
-	newList indexOf:cat ifAbsent:[newList add:cat]
-].
-newList sort.
-^ newList
-!
-listOfClassHierarchyOf:aClass
-"return a hierarchy class-list"
-^ (aClass allSuperclasses reverse ,
-(Array with:aClass),
-aClass allSubclassesInOrder) collect:[:c | c name]
-"
-|newList theClass|
-theClass := aClass.
-newList := Text with:theClass name.
-[theClass ~~ Object] whileTrue:[
-	theClass := theClass superclass.
-	newList add:theClass name
-].
-newList reverse.
-^ newList
-"
 !
 listOfAllClassesInCategory:aCategory
 "return a list of all classes in a given category"
 ].
 (newList size == 0) ifTrue:[^ nil].
 ^ newList sort
 !
-classHierarchyDo:aBlock
+doClassMenu:aBlock
-"eavluate the 2-arg block for every class,
+"a helper - check if class is selected and evaluate aBlock
-starting at Object; passing class and nesting level to the block."
+while showing waitCursor"
-|classes s classDict l|
+self checkClassSelected ifTrue:[
+	self withWaitCursorDo:aBlock
-classes := Smalltalk allClasses.
+]
-classDict := IdentityDictionary new:classes size.
+!
-classes do:[:aClass |
-	s := aClass superclass.
+checkClassSelected
-	s notNil ifTrue:[
+"warn and return false, if no class is selected"
-	    l := classDict at:s ifAbsent:[nil].
-	    l isNil ifTrue:[
+currentClass isNil ifTrue:[
-		l := OrderedCollection new:5.
+	self warn:'select a class first'.
-		classDict at:s put:l
+	^ false
-	    ].
+].
-	    l add:aClass
+^ true
-	]
+!
-].
-self classHierarchyOf:Object level:0 do:aBlock using:classDict
+updateClassList
-!
+self updateClassListWithScroll:true
+!
-classHierarchyOf:aClass level:level do:aBlock using:aDictionary
-"evaluate the 2-arg block for every subclass of aClass,
+listOfClassHierarchyOf:aClass
-passing class and nesting level to the block."
+"return a hierarchy class-list"
-|names subclasses|
+|classes|
-aBlock value:aClass value:level.
+classes := aClass allSuperclasses reverse , (Array with:aClass).
-subclasses := aDictionary at:aClass ifAbsent:[nil].
+fullProtocol ifFalse:[
-(subclasses size == 0) ifFalse:[
+	classes := classes , aClass allSubclassesInOrder
-	names := subclasses collect:[:class | class name].
+].
-	names sortWith:subclasses.
+^ classes collect:[:c | c name]
-	subclasses do:[:aSubClass |
-	    self classHierarchyOf:aSubClass level:(level + 1) do:aBlock using:aDictionary
-	]
-]
-!
-listOfAllMethodCategoriesInClass:aClass
-"answer a list of all method categories of the argument, aClass"
-|newList cat|
-newList := Text new.
-aClass methodArray do:[:aMethod |
-	cat := aMethod category.
-	cat isNil ifTrue:[
-	    cat := '* no category *'
-	].
-	(newList includes:cat) ifFalse:[newList add:cat]
-].
-(newList size == 0) ifTrue:[^ nil].
-newList add:'* all *'.
-^ newList sort
-!
-listOfAllSelectorsInCategory:aCategory ofClass:aClass
-"answer a list of all selectors in a given method category
-of the argument, aClass"
-|newList searchCategory selector|
-(aCategory = '* all *') ifTrue:[
-	newList := aClass selectorArray asText
-] ifFalse:[
-	(aCategory = '* no category *') ifTrue:[
-	    searchCategory := nil
-	] ifFalse:[
-	    searchCategory := aCategory
-	].
-	newList := Text new.
-	aClass methodArray do:[:aMethod |
-	    (aMethod category = searchCategory) ifTrue:[
-		selector := aClass selectorForMethod:aMethod.
-		selector notNil ifTrue:[
-		    aMethod isWrapped ifTrue:[
-			selector := selector , ' !!'
-		    ].
-		    (newList includes:selector) ifFalse:[
-			newList add:selector
-		    ]
-		]
-	    ]
-	]
-].
-(newList size == 0) ifTrue:[^ nil].
-^ newList sort
 !
 templateFor:className in:cat
 "return a class definition template - be smart in what is offered initially"
 	instanceVariableNames: ''''
 	classVariableNames: ''''
 	poolDictionaries: ''''
 	category: '''.
-	cat notNil ifTrue:[
+cat notNil ifTrue:[
-	    aString := aString , cat
+	aString := aString , cat
-	].
+].
-	aString := aString , ''''.
+aString := aString , '''
-	^ aString
-!
-template
-"return a method definition template"
+"
-^
+Replace ''' , className , ''', ''', name , ''' and
-'message selector and argument names
+the empty string arguments by true values.
-"comment stating purpose of message"
+Install (or change) the class by ''accepting'',
+either via the menu or the keyboard (usually CMD-A).
-|temporaries|
-statements
+To be nice to others (and yourself later), do not forget to
-'
+add some documentation; either under the classes documentation
-!
+protocol, or as a class comment.
+"
-compileCode:someCode
+'.
-(ReadStream on:someCode) fileIn
+^ aString
+!
+classClassDefinitionTemplateFor:name in:cat
+"common helper for newClass and newSubclass
+- show a template to define class name in category cat.
+Also, set acceptaction to install the class."
+currentMethodCategory := nil.
+currentMethod := currentSelector := nil.
+classListView deselect.
+fullClass ifFalse:[
+	methodCategoryListView contents:nil.
+	methodListView contents:nil
+].
+codeView contents:(self templateFor:name in:cat).
+codeView modified:false.
+codeView acceptAction:[:theCode |
+	codeView cursor:Cursor execute.
+	Object abortSignal catch:[
+	    |cls|
+	    cls := (Compiler evaluate:theCode asString notifying:codeView).
+	    cls isBehavior ifTrue:[
+		codeView modified:false.
+		self classCategoryUpdate.
+		self updateClassListWithScroll:false.
+		self switchToClassNamed:(cls name).
+	    ]
+	].
+	codeView cursor:(Cursor normal).
+].
+codeView explainAction:nil.
+self switchToClass:nil
+!
+renameCurrentClassTo:aString
+"helper - do the rename"
+self doClassMenu:[
+	|oldName oldSym newSym|
+	oldName := currentClass name.
+	oldSym := oldName asSymbol.
+"
+	currentClass setName:aString.
+	newSym := aString asSymbol.
+	Smalltalk at:oldSym put:nil.
+	Smalltalk removeKey:oldSym.
+	Smalltalk at:newSym put:currentClass.
+"
+"
+	currentClass renameTo:aString.
+"
+	Smalltalk renameClass:currentClass to:aString.
+	self updateClassList.
+	self updateMethodCategoryListWithScroll:false.
+	self updateMethodListWithScroll:false.
+	self withWaitCursorDo:[
+	    Transcript showCr:('searching for users of ' , oldSym); endEntry.
+	    self class browseReferendsOf:oldSym warnIfNone:false
+	]
+]
+!
+switchToClassNamed:aString
+|classSymbol theClass newCat|
+aString knownAsSymbol ifFalse:[^ self].
+classSymbol := aString asSymbol.
+theClass := Smalltalk at:classSymbol.
+theClass isBehavior ifTrue:[
+	classCategoryListView notNil ifTrue:[
+	    currentClassHierarchy isNil ifTrue:[
+		((newCat := theClass category) ~= currentClassCategory) ifTrue:[
+		    currentClassCategory := newCat.
+		    newCat isNil ifTrue:[
+			classCategoryListView selectElement:'* no category *'
+		    ] ifFalse:[
+			classCategoryListView selectElement:newCat.
+		    ].
+		    "/ classCategoryListView makeSelectionVisible.
+		]
+	    ]
+	].
+	self updateClassList.
+	self switchToClass:theClass.
+	classListView selectElement:aString.
+	self classSelectionChanged
+]
+!
+switchToClassNameMatching:aMatchString
+|classNames thisName box|
+classNames := OrderedCollection new.
+Smalltalk allBehaviorsDo:[:aClass |
+	thisName := aClass name.
+	(aMatchString match:thisName) ifTrue:[
+	    classNames add:thisName
+	]
+].
+(classNames size == 0) ifTrue:[^ nil].
+(classNames size == 1) ifTrue:[
+	^ self switchToClassNamed:(classNames at:1)
+].
+box := self listBoxTitle:'select class to switch to:'
+		      okText:'ok'
+			list:classNames sort.
+box action:[:aString | self switchToClassNamed:aString].
+box showAtPointer
 ! !
-!SystemBrowser methodsFor:'user interaction'!
+!SystemBrowser methodsFor:'variable stuff'!
-instanceProtocol
+updateVariableList
-showInstance ifFalse:[
+|l subList flags last nameAccessSelector class oldSelection|
-	self checkSelectionChangeAllowed ifTrue:[
-	    classToggle turnOff.
+variableListView isNil ifTrue:[^ self].
-	    instanceToggle turnOn.
-	    showInstance := true.
+oldSelection := variableListView selectionValue.
-	    currentClass notNil ifTrue:[
-		self classSelectionChanged
+l := OrderedCollection new.
+"
+show classVars, if classProtocol is shown (instead of classInstance vars)
+"
+showInstance ifTrue:[
+	nameAccessSelector := #instVarNames
+] ifFalse:[
+	nameAccessSelector := #classVarNames
+].
+class := currentClass notNil ifTrue:[currentClass] ifFalse:[actualClass].
+class isNil ifTrue:[class := currentClassHierarchy].
+class withAllSuperclasses do:[:aClass |
+	|ignore|
+	ignore := fullProtocol
+		  and:[classListView valueIsInSelection:(aClass name asString)].
+	ignore ifFalse:[
+	    subList := aClass perform:nameAccessSelector.
+	    subList size ~~ 0 ifTrue:[
+		l := l , (subList asOrderedCollection reverse).
+		l := l , (OrderedCollection with:'---- ' , aClass name , ' ---------').
+	    ]
+	]
+].
+l reverse.
+variableListView setAttributes:nil.
+variableListView list:l.
+l keysAndValuesDo:[:index :entry |
+	(entry startsWith:'---') ifTrue:[
+	    variableListView attributeAt:index put:#disabled.
+	    last := index
+	]
+].
+last notNil ifTrue:[variableListView scrollToLine:last].
+oldSelection notNil ifTrue:[
+	variableListView selectElement:oldSelection
+]
+!
+unhilightMethods
+"unhighlight items in method list"
+variableListView isNil ifTrue:[^ self].
+methodListView notNil ifTrue:[
+	1 to:methodListView list size do:[:entry |
+	     methodListView attributeAt:entry put:nil.
+	].
+].
+!
+hilightMethodsInMethodCategoryList:inCat inMethodList:inMethods
+"search for methods  which access the selected
+variable, and highlight them"
+|name idx redefinedSelectors|
+variableListView isNil ifTrue:[^ self].
+inCat ifTrue:[self unhilightMethodCategories].
+inMethods ifTrue:[self unhilightMethods].
+actualClass isNil ifTrue:[^ self].
+(methodCategoryListView isNil
+and:[methodListView isNil]) ifTrue:[^ self].
+name := variableListView selectionValue.
+name isNil ifTrue:[^ self].
+self withCursor:(Cursor questionMark) do:[
+	|classes filter any|
+	classes := Array with:currentClass.
+	currentClassHierarchy notNil ifTrue:[
+	    fullProtocol ifTrue:[
 	    ].
-	    codeView modified:false.
+	    classes := classes , currentClass allSuperclasses.
+	    redefinedSelectors := IdentitySet new.
+	].
+	showInstance ifTrue:[
+	    filter := self class filterToSearchInstRefsTo:name modificationsOnly:false
 	] ifFalse:[
-	    instanceToggle turnOff.
+	    filter := self class filterToSearchClassRefsTo:name modificationsOnly:false
-	    classToggle turnOn
+	].
-	]
-]
+	any := false.
-!
+	"
+	 highlight the method that ref this variable
-classProtocol
+	"
-showInstance ifTrue:[
+	classes do:[:someClass |
-	self checkSelectionChangeAllowed ifTrue:[
+	    someClass methodArray with:someClass selectorArray
-	    instanceToggle turnOff.
+	    do:[:method :selector |
-	    classToggle turnOn.
-	    showInstance := false.
+		(inCat
-	    currentClass notNil ifTrue:[
+		or:[methodListView list notNil
-		self classSelectionChanged
+		    and:[methodListView list includes:selector]])
+		ifTrue:[
+		    (redefinedSelectors isNil
+		    or:[(redefinedSelectors includes:selector) not])
+		   ifTrue:[
+		       (filter value:someClass value:method value:selector) ifTrue:[
+			   |idx cat|
+			   (inCat
+			   and:[methodCategoryListView notNil
+			   and:[methodCategoryListView list notNil]]) ifTrue:[
+			       cat := method category.
+			       "
+				highlight the methodCategory
+			       "
+			       idx := methodCategoryListView list indexOf:cat.
+			       idx ~~ 0 ifTrue:[
+				   methodCategoryListView attributeAt:idx put:#bold.
+			       ].
+			   ].
+			   (inMethods
+			   and:[methodListView notNil
+			   and:[methodListView list notNil]]) ifTrue:[
+			       "
+				highlight the method
+			       "
+			       idx := methodListView list indexOf:selector.
+			       idx ~~ 0 ifTrue:[
+				   methodListView attributeAt:idx put:#bold.
+			       ].
+			       any := true
+			   ].
+		       ].
+		       redefinedSelectors notNil ifTrue:[
+			   redefinedSelectors add:selector
+		       ]
+		    ]
+		]
+	    ]
+	].
+	any ifTrue:[
+	    self setSearchPattern:name
+	]
+]
+!
+hilightMethodsInMethodCategoryList
+"search for methods  which access the selected
+variable, and highlight them"
+self hilightMethodsInMethodCategoryList:true inMethodList:false
+!
+unhilightMethodCategories
+"unhighlight items in method list"
+variableListView isNil ifTrue:[^ self].
+methodCategoryListView notNil ifTrue:[
+	1 to:methodCategoryListView list size do:[:entry |
+	    methodCategoryListView attributeAt:entry put:nil.
+	]
+].
+!
+hilightMethodsInMethodList
+"search for methods  which access the selected
+variable, and highlight them"
+self hilightMethodsInMethodCategoryList:false inMethodList:true
+! !
+!SystemBrowser methodsFor:'class list menu'!
+classDefinition
+"show class definition in codeView and setup accept-action for
+a class-definition change.
+Extract documentation either from a documentation method or
+from the comment - not a biggy, but beginners will like
+it when exploring the system."
+self doClassMenu:[
+	|m s aStream isComment|
+	aStream := WriteStream on:(String new:200).
+	currentClass fileOutDefinitionOn:aStream.
+	currentClass isLoaded ifTrue:[
+	    "
+	     add documentation as a comment, if there is any
+	    "
+	    m := currentClass class compiledMethodAt:#documentation.
+	    m notNil ifTrue:[
+		s := m comment.
+		isComment := false.
+	    ] ifFalse:[
+		"try comment"
+		s := currentClass comment.
+		s notNil ifTrue:[
+		    isComment := true
+		]
 	    ].
-	    codeView modified:false.
+	].
+	s notNil ifTrue:[
+	    aStream cr.
+	    aStream cr.
+	    aStream cr.
+	    aStream cr.
+	    aStream cr.
+	    aStream nextPut:$" ; cr; nextPutAll:' Documentation:'; cr.
+	    aStream cr.
+	    aStream nextPutAll:s.
+	    aStream cr; cr.
+	    aStream nextPutAll:' Notice: '; cr.
+	    aStream nextPutAll:'   the above string has been extracted from the classes '.
+	    aStream nextPutAll:(isComment ifTrue:['comment.'] ifFalse:['documentation method.']).
+	    aStream cr.
+	    aStream nextPutAll:'   It will not preserved when accepting a new class definition.'; cr.
+	    aStream nextPut:$".
+	].
+	codeView contents:(aStream contents).
+	codeView modified:false.
+	codeView acceptAction:[:theCode |
+	    codeView cursor:Cursor execute.
+	    Object abortSignal catch:[
+		(Compiler evaluate:theCode asString notifying:codeView)
+		isBehavior ifTrue:[
+		    codeView modified:false.
+		    self classCategoryUpdate.
+		    self updateClassListWithScroll:false.
+		]
+	    ].
+	    codeView cursor:Cursor normal.
+	].
+	codeView explainAction:nil.
+	methodListView notNil ifTrue:[
+	    methodListView deselect
+	].
+	aspect := #definition.
+	self normalLabel
+]
+!
+initializeClassMenu
+|labels menu|
+labels := resources array:#(
+					'fileOut'
+					'printOut'
+					'printOut protocol'
+				      " 'printOut full protocol' "
+					'-'
+					'SPAWN_CLASS'
+					'spawn full protocol'
+					'spawn hierarchy'
+					'spawn subclasses'
+					'-'
+					'hierarchy'
+					'definition'
+					'comment'
+					'class instvars'
+				      " 'protocols' "
+					'-'
+"/                                        'variable search'
+					'class refs'
+					'-'
+					'new class'
+					'new subclass'
+					'rename ...'
+					'remove').
+menu := PopUpMenu labels:labels
+		   selectors:#(classFileOut
+			       classPrintOut
+			       classPrintOutProtocol
+			     " classPrintOutFullProtocol "
+			       nil
+			       classSpawn
+			       classSpawnFullProtocol
+			       classSpawnHierarchy
+			       classSpawnSubclasses
+			       nil
+			       classHierarchy
+			       classDefinition
+			       classComment
+			       classClassInstVars
+			     "  classProtocols "
+			       nil
+"/                               variables
+			       classRefs
+			       nil
+			       classNewClass
+			       classNewSubclass
+			       classRename
+			       classRemove)
+		    receiver:self
+			 for:classListView.
+fullProtocol ifFalse:[
+	classListView middleButtonMenu:menu.
+].
+self initializeVariableListMenu.
+!
+classFileOut
+"fileOut the current class.
+Catch errors (sure, you like to know if it failed) and
+warn if any)"
+self doClassMenu:[
+	self busyLabel:'saving %1' with:currentClass name.
+	Class fileOutErrorSignal handle:[:ex |
+	    self warn:'cannot create: %1' with:ex parameter.
+	    ex return.
+	] do:[
+	    currentClass fileOut.
+	].
+	self normalLabel.
+]
+!
+doClassMenuWithSelection:aBlock
+"a helper - if there is a selection, which represents a classes name,
+evaluate aBlock, passing that class and optional selector as arguments.
+Otherwise, check if a class is selected and evaluate aBlock with the
+current class."
+|string words clsName cls sel isMeta w|
+string := codeView selection.
+string notNil ifTrue:[
+	self extractClassAndSelectorFromSelectionInto:[:c :s :m |
+	    clsName := c.
+	    sel := s.
+	    isMeta := m.
+	].
+	clsName isNil ifTrue:[
+	    string := string asString withoutSeparators.
+	    words := string asCollectionOfWords.
+	    words notNil ifTrue:[
+		clsName := words first.
+		(clsName endsWith:'class') ifTrue:[
+		    isMeta := true.
+		    clsName := clsName copyTo:(clsName size - 5)
+		] ifFalse:[
+		    isMeta := false
+		].
+		sel := Parser selectorInExpression:string.
+	    ]
+	].
+	clsName notNil ifTrue:[
+	    (cls := Smalltalk classNamed:clsName) notNil ifTrue:[
+		isMeta ifTrue:[
+		    cls := cls class
+		].
+		self withWaitCursorDo:[
+		    aBlock value:cls value:sel.
+		].
+		^ self
+	    ] ifFalse:[
+		self warn:'no class named: %1 - spawning current' with:clsName
+	    ]
+	].
+].
+classMethodListView notNil ifTrue:[
+	sel := classMethodListView selectionValue.
+	sel notNil ifTrue:[
+	    sel := self selectorFromClassMethodString:sel
+	]
+].
+self doClassMenu:[aBlock value:currentClass value:sel]
+!
+classSpawn
+"create a new SystemBrowser browsing current class,
+or if there is a selection, spawn a browser on the selected class
+even a class/selector pair can be specified."
+|browser|
+self doClassMenuWithSelection:[:cls :sel |
+	cls isMeta ifTrue:[
+	    Smalltalk allBehaviorsDo:[:aClass |
+		aClass class == cls ifTrue:[
+		    browser := self class browseClass:aClass.
+		    browser classProtocol.
+		    sel notNil ifTrue:[
+			browser switchToMethodNamed:sel
+		    ].
+		    ^ self
+		].
+	    ].
+	    self warn:'oops, no class for this metaclass'.
+	    ^ self
+	].
+	browser := self class browseClass:cls.
+	cls hasMethods ifFalse:[
+	    browser classProtocol.
+	].
+	sel notNil ifTrue:[
+	    browser switchToMethodNamed:sel
+	].
+]
+"
+select 'Smalltalk allClassesDo:' and use spawn from the class menu
+select 'Smalltalk'               and use spawn from the class menu
+"
+!
+classSpawnHierarchy
+"create a new HierarchyBrowser browsing current class"
+self doClassMenuWithSelection:[:cls :sel |
+	self class browseClassHierarchy:cls
+]
+!
+classSpawnSubclasses
+"create a new browser browsing current class's subclasses"
+|subs|
+self doClassMenuWithSelection:[:cls :sel |
+	subs := cls allSubclasses.
+	(subs notNil and:[subs size ~~ 0]) ifTrue:[
+	    self class browseClasses:subs title:('subclasses of ' , cls name)
+	]
+]
+!
+classPrintOutFullProtocol
+|printStream|
+self doClassMenu:[
+	printStream := Printer new.
+	currentClass printOutFullProtocolOn:printStream.
+	printStream close
+]
+!
+classPrintOutProtocol
+|printStream|
+self doClassMenu:[
+	printStream := Printer new.
+	currentClass printOutProtocolOn:printStream.
+	printStream close
+]
+!
+classPrintOut
+|printStream|
+self doClassMenu:[
+	printStream := Printer new.
+	currentClass printOutOn:printStream.
+	printStream close
+]
+!
+classHierarchy
+"show current classes hierarchy in codeView"
+|aStream|
+self doClassMenu:[
+	aStream := WriteStream on:(String new:200).
+	actualClass printHierarchyOn:aStream.
+	codeView contents:(aStream contents).
+	codeView modified:false.
+	codeView acceptAction:nil.
+	codeView explainAction:nil.
+	methodListView notNil ifTrue:[
+	    methodListView deselect
+	].
+	aspect := #hierarchy.
+	self normalLabel
+]
+!
+classNewClass
+"create a class-definition prototype in codeview"
+|nm|
+currentClass notNil ifTrue:[
+	nm := currentClass superclass name
+] ifFalse:[
+	nm := 'Object'
+].
+self classClassDefinitionTemplateFor:nm in:currentClassCategory.
+aspect := nil.
+!
+classClassInstVars
+"show class instance variables in codeView and setup accept-action
+for a class-instvar-definition change"
+|s|
+self doClassMenu:[
+	s := WriteStream on:(String new).
+	currentClass fileOutClassInstVarDefinitionOn:s.
+	codeView contents:(s contents).
+	codeView modified:false.
+	codeView acceptAction:[:theCode |
+	    codeView cursor:Cursor execute.
+	    Object abortSignal catch:[
+		Compiler evaluate:theCode asString notifying:codeView.
+		codeView modified:false.
+		self updateClassList.
+	    ].
+	    codeView cursor:Cursor normal.
+	].
+	codeView explainAction:nil.
+	methodListView notNil ifTrue:[
+	    methodListView deselect
+	].
+	aspect := #classInstVars.
+	self normalLabel
+]
+!
+classSpawnFullProtocol
+"create a new browser, browsing current classes full protocol"
+self doClassMenuWithSelection:[:cls :sel |
+	self class browseFullClassProtocol:cls
+]
+!
+classProtocols
+^ self
+!
+classRemove
+"user requested remove of current class and all subclasses -
+count subclasses and let user confirm removal."
+|count t box|
+currentClass notNil ifTrue:[
+	count := currentClass allSubclasses size.
+	t := 'remove ' , currentClass name.
+	count ~~ 0 ifTrue:[
+	   t := t , '\(with ' , count printString , ' subclass'.
+	   count ~~ 1 ifTrue:[
+		t := t , 'es'
+	   ].
+	   t := (t , ')') withCRs
+	].
+	box := YesNoBox
+		   title:t
+		   yesText:(resources at:'remove')
+		   noText:(resources at:'abort').
+	box confirm ifTrue:[
+	    "after querying user - do really remove current class
+	     and all subclasses
+	    "
+	    self doClassMenu:[
+		"
+		 query ?
+		"
+		currentClass allSubclassesDo:[:aSubClass |
+		    (CheckForInstancesWhenRemovingClasses not
+		    or:[aSubClass hasInstances not
+		    or:[self confirm:(aSubClass name , ' has instances - remove anyway ?')]])
+			ifTrue:[
+			    Smalltalk removeClass:aSubClass
+		    ]
+		].
+		(CheckForInstancesWhenRemovingClasses not
+		or:[currentClass hasInstances not
+		or:[self confirm:(currentClass name , ' has instances - remove anyway ?')]])
+		    ifTrue:[
+			Smalltalk removeClass:currentClass.
+		].
+		self switchToClass:nil.
+		Smalltalk changed.
+		self updateClassList.
+		"if it was the last in its category, update class category list"
+"
+		classListView numberOfLines == 0 ifTrue:[
+		    self updateClassCategoryListWithScroll:false
+		].
+"
+		methodCategoryListView notNil ifTrue:[methodCategoryListView contents:nil].
+		methodListView notNil ifTrue:[methodListView contents:nil].
+		codeView contents:nil.
+		codeView modified:false
+	    ]
+	]
+]
+!
+classComment
+"show the classes comment in the codeView.
+Also, set acceptaction to change the comment."
+self doClassMenu:[
+	codeView contents:(currentClass comment).
+	codeView modified:false.
+	codeView acceptAction:[:theCode |
+	    Object abortSignal catch:[
+		lockUpdates := true.
+		currentClass comment:theCode asString.
+		codeView modified:false.
+	    ].
+	    lockUpdates := false.
+	].
+	codeView explainAction:nil.
+	methodListView notNil ifTrue:[
+	    methodListView deselect
+	].
+	aspect := #comment.
+	self normalLabel
+]
+!
+classRefs
+self doClassMenu:[
+	self withCursor:(Cursor questionMark) do:[
+	    self class browseReferendsOf:currentClass name asSymbol
+	]
+]
+!
+classNewSubclass
+"create a subclass-definition prototype in codeview"
+self doClassMenu:[
+	self classClassDefinitionTemplateFor:(currentClass name)
+					  in:(currentClass category).
+	aspect := nil
+]
+!
+classUses
+"a powerful tool, when trying to learn more about where
+a class is used. This one searches all uses of a class,
+and shows a list of uses - try it and like it"
+self doClassMenu:[
+	self withCursor:(Cursor questionMark) do:[
+	    self class browseUsesOf:currentClass
+	]
+]
+!
+classRename
+"launch an enterBox for new name and query user"
+|box|
+self checkClassSelected ifFalse:[^ self].
+box := self enterBoxTitle:(resources string:'rename %1 to:' with:currentClass name) okText:'rename'.
+box initialText:(currentClass name).
+box action:[:aString | self renameCurrentClassTo:aString].
+box showAtPointer
+!
+classSpawnFullHierarchy
+"create a new HierarchyBrowser browsing current class"
+self doClassMenuWithSelection:[:cls :sel |
+	self class browseFullClassHierarchy:cls
+]
+! !
+!SystemBrowser methodsFor:'class category stuff'!
+checkClassCategorySelected
+currentClassCategory isNil ifTrue:[
+	self warn:'select a class category first'.
+	^ false
+].
+^ true
+!
+listOfAllClassCategories
+"return a list of all class categories"
+|newList cat|
+newList := Text with:'* all *' with:'* hierarchy *'.
+Smalltalk allBehaviorsDo:[:aClass |
+	cat := aClass category.
+	cat isNil ifTrue:[
+	    cat := '* no category *'
+	].
+	newList indexOf:cat ifAbsent:[newList add:cat]
+].
+newList sort.
+^ newList
+!
+classCategorySelectionChanged
+"class category has changed - update dependent views"
+self withWaitCursorDo:[
+	self switchToClass:nil.
+	actualClass := nil.
+	currentMethodCategory := nil.
+	currentMethod := currentSelector := nil.
+	self updateClassList.
+	self updateMethodCategoryList.
+	self updateMethodList.
+	self updateCodeView.
+	codeView explainAction:nil.
+	codeView acceptAction:nil
+]
+!
+classCategorySelection:lineNr
+"user clicked on a class category line - show classes.
+If switching to hierarchy or all, keep current selections"
+|newCategory oldClass classIndex index|
+newCategory := classCategoryListView selectionValue.
+(newCategory startsWith:'*') ifTrue:[
+	"etiher all or hierarchy;
+	 remember current selections and switch after showing class list"
+	oldClass := currentClass
+].
+currentClassCategory := newCategory.
+oldClass isNil ifTrue:[
+	self classCategorySelectionChanged
+] ifFalse:[
+	self withWaitCursorDo:[
+	    self updateClassList
+	].
+	"stupid - search for class name in (indented) list"
+	index := 1.
+	classListView list do:[:elem |
+	    (elem endsWith:(oldClass name)) ifTrue:[
+		classIndex := index
+	    ].
+	    index := index + 1
+	].
+	classIndex notNil ifTrue:[
+	    classListView selection:classIndex.
+	    self switchToClass:(Smalltalk at:(oldClass name asSymbol))
 	] ifFalse:[
-	    instanceToggle turnOn.
+	    self normalLabel.
-	    classToggle turnOff
 	]
 ]
 !
 updateClassCategoryListWithScroll:scroll
 oldClassCategory := currentClassCategory.
 oldClass := currentClass.
 oldMethodCategory := currentMethodCategory.
 oldMethod := currentMethod.
 oldMethod notNil ifTrue:[
-	oldSelector := methodListView selectionValue
+	oldSelector := currentSelector
 ].
 classCategoryListView notNil ifTrue:[
 	newCategoryList := self listOfAllClassCategories.
 	newCategoryList = classCategoryListView list ifFalse:[
 updateClassCategoryList
 self updateClassCategoryListWithScroll:true
 !
-updateClassListWithScroll:scroll
+allClassesInCurrentCategoryInOrderDo:aBlock
-|classes oldClassName|
+"evaluate aBlock for all classes in the current class category;
+superclasses come first - then subclasses"
-classListView notNil ifTrue:[
-	currentClass notNil ifTrue:[
+|classes|
-	    oldClassName := currentClass name.
-	    currentClass := Smalltalk at:(oldClassName asSymbol).
+currentClassCategory notNil ifTrue:[
-	].
+	classes := OrderedCollection new.
+	Smalltalk allBehaviorsDo:[:aClass |
-	currentClassCategory notNil ifTrue:[
+	    aClass isMeta ifFalse:[
-	    classes := self listOfAllClassesInCategory:currentClassCategory
+		(aClass category = currentClassCategory) ifTrue:[
-	] ifFalse:[
+		    classes add:aClass
-	    currentClassHierarchy notNil ifTrue:[
+		]
-		classes := self listOfClassHierarchyOf:currentClassHierarchy
 	    ]
 	].
+	classes topologicalSort:[:a :b | b isSubclassOf:a].
-	classListView list = classes ifFalse:[
+	classes do:aBlock
-	    scroll ifTrue:[
+]
-		classListView contents:classes
+!
-	    ] ifFalse:[
-		classListView setContents:classes
+allClassesInCurrentCategoryDo:aBlock
-	    ].
+"evaluate aBlock for all classes in the current class category;
-	    oldClassName notNil ifTrue:[
+superclasses come first - then subclasses"
-		classListView setContents:classes.
-		classListView selectElement:oldClassName
+currentClassCategory notNil ifTrue:[
-	    ] ifFalse:[
+	Smalltalk allBehaviorsDo:[:aClass |
-		variableListView notNil ifTrue:[variableListView contents:nil]
+	    aClass isMeta ifFalse:[
+		(aClass category = currentClassCategory) ifTrue:[
+		    aBlock value:aClass
+		]
 	    ]
-	]
+	].
 ]
 !
-updateClassList
+renameCurrentClassCategoryTo:aString
-self updateClassListWithScroll:true
+"helper - do the rename"
-!
+|any categories|
-updateVariableList
-|l subList flags last|
+currentClassCategory notNil ifTrue:[
+	any := false.
-variableListView isNil ifTrue:[^ self].
+	Smalltalk allBehaviorsDo:[:aClass |
+	    aClass category = currentClassCategory ifTrue:[
-l := OrderedCollection new.
+		aClass category:aString.
-actualClass withAllSuperclasses do:[:aClass |
+		any := true
-	subList := aClass instVarNames.
-	subList size ~~ 0 ifTrue:[
-	    l := l , (subList asOrderedCollection reverse).
-	    l := l , (OrderedCollection with:'---- ' , aClass name , ' ---------').
-	]
-].
-l reverse.
-variableListView attributes:nil.
-variableListView list:l.
-l keysAndValuesDo:[:index :entry |
-	(entry startsWith:'---') ifTrue:[
-	    variableListView attributeAt:index put:#halfIntensity.
-	    last := index
-	]
-].
-last notNil ifTrue:[variableListView scrollToLine:last]
-!
-updateMethodCategoryListWithScroll:scroll
-|categories|
-methodCategoryListView notNil ifTrue:[
-	currentClass notNil ifTrue:[
-	    categories := self listOfAllMethodCategoriesInClass:actualClass
-	].
-	methodCategoryListView list = categories ifFalse:[
-	    scroll ifTrue:[
-		methodCategoryListView contents:categories
-	    ] ifFalse:[
-		methodCategoryListView setContents:categories
-	    ].
-	    currentMethodCategory notNil ifTrue:[
-		methodCategoryListView selectElement:currentMethodCategory
 	    ]
-	]
+	].
-]
+	any ifFalse:[
-!
+	    categories := classCategoryListView list.
+	    categories remove:currentClassCategory.
-updateMethodCategoryList
+	    categories add:aString.
-self updateMethodCategoryListWithScroll:true
+	    categories sort.
-!
+	    classCategoryListView setContents:categories.
+	    currentClassCategory := aString.
-updateMethodListWithScroll:scroll
+	    classCategoryListView selectElement:aString.
-|selectors scr first last|
+	] ifTrue:[
+	    currentClassCategory := aString.
-methodListView notNil ifTrue:[
+	    self updateClassCategoryList.
-	currentMethodCategory notNil ifTrue:[
+	    self updateClassListWithScroll:false
-	    selectors := self listOfAllSelectorsInCategory:currentMethodCategory
+	]
-						   ofClass:actualClass
+]
-	].
+! !
-	scr := scroll.
-	first := methodListView firstLineShown.
+!SystemBrowser methodsFor:'class-method stuff'!
-	first ~~ 1 ifTrue:[
-	    last := methodListView lastLineShown.
-	    selectors size <= (last - first + 1) ifTrue:[
-		scr := true
-	    ]
-	].
-	methodListView list = selectors ifFalse:[
-	    scr ifTrue:[
-		methodListView contents:selectors
-	    ] ifFalse:[
-		methodListView setContents:selectors
-	    ]
-	].
-]
-!
-updateMethodList
-self updateMethodListWithScroll:true
-!
-updateCodeView
-|code aStream|
-fullClass ifTrue:[
-	currentClass notNil ifTrue:[
-" this is too slow for big classes ...
-	    code := String new:1000.
-	    aStream := WriteStream on:code.
-	    currentClass fileOutOn:aStream
-"
-	    aStream := FileStream newFileNamed:'__temp'.
-	    aStream isNil ifTrue:[
-		self notify:'cannot create temporary file.'.
-		codeView contents:nil.
-		codeView modified:false.
-		^ self
-	    ].
-	    currentClass fileOutOn:aStream.
-	    aStream close.
-	    aStream := FileStream oldFileNamed:'__temp'.
-	    aStream isNil ifTrue:[
-		self notify:'oops - cannot reopen temp file'.
-		codeView contents:nil.
-		codeView modified:false.
-		^ self
-	    ].
-	    code := aStream contents.
-	    aStream close.
-	    OperatingSystem removeFile:'__temp'
-	]
-] ifFalse:[
-	currentMethod notNil ifTrue:[
-	    code := currentMethod source
-	]
-].
-codeView contents:code.
-codeView modified:false
-!
-classSelectionChanged
-|oldMethodCategory oldMethod|
-self withWaitCursorDo:[
-	oldMethodCategory := currentMethodCategory.
-	oldMethod := currentMethod.
-	showInstance ifTrue:[
-	    actualClass := currentClass
-	] ifFalse:[
-	    actualClass := currentClass class
-	].
-	currentMethodCategory := nil.
-	currentMethod := nil.
-	self updateVariableList.
-	self updateMethodCategoryList.
-	oldMethodCategory notNil ifTrue:[
-	    methodCategoryListView selectElement:oldMethodCategory.
-	    methodCategoryListView selection notNil ifTrue:[
-		currentMethodCategory := oldMethodCategory.
-		self methodCategorySelectionChanged
-	    ]
-	].
-	self updateMethodList.
-	self updateCodeView.
-	fullClass ifTrue:[
-	    codeView acceptAction:[:theCode |
-		codeView cursor:Cursor execute.
-		Object abortSignal catch:[
-		    self compileCode:theCode asString.
-		    codeView modified:false.
-		].
-		codeView cursor:Cursor normal.
-	    ].
-	    codeView explainAction:nil
-	] ifFalse:[
-	    self classDefinition.
-	    codeView acceptAction:[:theCode |
-		codeView cursor:Cursor execute.
-		Object abortSignal catch:[
-		    (Compiler evaluate:theCode asString notifying:codeView)
-		    isBehavior ifTrue:[
-			self classCategoryUpdate.
-			self updateClassListWithScroll:false.
-			codeView modified:false.
-		    ].
-		].
-		codeView cursor:Cursor normal.
-	    ].
-	    codeView explainAction:nil
-	].
-	classCategoryListView notNil ifTrue:[
-	    (currentClassCategory = currentClass category) ifFalse:[
-		currentClassCategory := currentClass category.
-		classCategoryListView selectElement:currentClassCategory
-	    ]
-	].
-	"set self for doits. This allows accessing the current class
-	 as self, and access to the class variables by name."
-	codeView doItAction:[:theCode |
-	    |compiler|
-	    currentClass isNil ifTrue:[
-		compiler := Compiler
-	    ] ifFalse:[
-		compiler := currentClass compiler
-	    ].
-	    compiler
-		evaluate:theCode
-		in:nil
-		receiver:currentClass
-		notifying:codeView
-		logged:false
-		ifFail:nil
-	]
-]
-!
-classCategorySelectionChanged
-"class category has changed - update dependant views"
-self withWaitCursorDo:[
-	self switchToClass:nil.
-	actualClass := nil.
-	currentMethodCategory := nil.
-	currentMethod := nil.
-	self updateClassList.
-	self updateMethodCategoryList.
-	self updateMethodList.
-	self updateCodeView.
-	codeView explainAction:nil.
-	codeView acceptAction:nil
-]
-!
-classCategorySelection:lineNr
-"user clicked on a class category line - show classes.
-If switching to hierarchy or all, keep current selections"
-|newCategory oldClass classIndex index|
-newCategory := classCategoryListView selectionValue.
-(newCategory startsWith:'*') ifTrue:[
-	"etiher all or hierarchy;
-	 remember current selections and switch after showing class list"
-	oldClass := currentClass
-].
-currentClassCategory := newCategory.
-oldClass isNil ifTrue:[
-	self classCategorySelectionChanged
-] ifFalse:[
-	self withWaitCursorDo:[
-	    self updateClassList
-	].
-	"stupid - search for class name in (indented) list"
-	index := 1.
-	classListView list do:[:elem |
-	    (elem endsWith:(oldClass name)) ifTrue:[
-		classIndex := index
-	    ].
-	    index := index + 1
-	].
-	classIndex notNil ifTrue:[
-	    classListView selection:classIndex.
-	    self switchToClass:(Smalltalk at:(oldClass name asSymbol))
-	] ifFalse:[
-	    self normalLabel.
-	]
-]
-!
-classSelection:lineNr
-"user clicked on a class line - show method categories"
-|classSymbol cls|
-classSymbol := classListView selectionValue withoutSpaces asSymbol.
-(Smalltalk includesKey:classSymbol) ifTrue:[
-	cls := Smalltalk at:classSymbol
-].
-cls notNil ifTrue:[
-	self switchToClass:cls.
-	self classSelectionChanged
-]
-!
-methodCategorySelectionChanged
-"method category selection has changed - update dependant views"
-self withWaitCursorDo:[
-	currentMethod := nil.
-	self updateMethodList.
-	self updateCodeView.
-	currentMethodCategory notNil ifTrue:[
-	    methodCategoryListView selectElement:currentMethodCategory
-	].
-	codeView acceptAction:[:theCode |
-	    codeView cursor:Cursor execute.
-	    Object abortSignal catch:[
-		actualClass compiler compile:theCode asString
-				    forClass:actualClass
-				  inCategory:currentMethodCategory
-				   notifying:codeView.
-		codeView modified:false.
-		self updateMethodListWithScroll:false.
-	    ].
-	    codeView cursor:Cursor normal.
-	].
-	codeView explainAction:[:theCode :theSelection |
-	    self showExplanation:(Explainer explain:theSelection
-						 in:theCode
-					   forClass:actualClass)
-	]
-]
-!
-methodCategorySelection:lineNr
-"user clicked on a method category line - show selectors"
-currentClass isNil ifTrue:[^ self].
-currentMethodCategory := methodCategoryListView selectionValue.
-self methodCategorySelectionChanged
-!
-methodSelectionChanged
-"method selection has changed - update dependant views"
-self withWaitCursorDo:[
-	self updateCodeView.
-	codeView acceptAction:[:theCode |
-	    codeView cursor:Cursor execute.
-	    Object abortSignal catch:[
-		actualClass compiler compile:theCode asString
-				    forClass:actualClass
-				    inCategory:currentMethodCategory
-				     notifying:codeView.
-		codeView modified:false.
-		self updateMethodListWithScroll:false.
-	    ].
-	    codeView cursor:Cursor normal.
-	].
-	codeView explainAction:[:theCode :theSelection |
-	    self showExplanation:(Explainer explain:theSelection
-						 in:theCode
-					   forClass:actualClass)
-	].
-	methodListView notNil ifTrue:[
-	    (currentMethod notNil and:[currentMethod isWrapped]) ifTrue:[
-		self initializeMethodMenu2
-	    ] ifFalse:[
-		self initializeMethodMenu
-	    ]
-	]
-]
-!
-methodSelection:lineNr
-"user clicked on a method line - show code"
-|selectorString selectorSymbol|
-currentClass isNil ifTrue:[^ self].
-selectorString := methodListView selectionValue.
-"
-kludge: check if its a wrapped one
-"
-(selectorString endsWith:' !!') ifTrue:[
-	selectorString := selectorString copyTo:(selectorString size - 2)
-].
-selectorSymbol := selectorString asSymbol.
-currentMethod := actualClass compiledMethodAt:selectorSymbol.
-methodCategoryListView notNil ifTrue:[
-	currentMethod notNil ifTrue:[
-	    (currentMethodCategory = currentMethod category) ifFalse:[
-		currentMethodCategory := currentMethod category.
-		methodCategoryListView selectElement:currentMethodCategory
-	    ]
-	]
-].
-self methodSelectionChanged
-!
 classFromClassMethodString:aString
 "helper for classMethod-list - extract class name from the string"
 |pos|
 pos := aString indexOf:(Character space).
 ^ aString copyFrom:(pos + 1)
 !
-listSelection:lineNr
+classMethodSelection:lineNr
 "user clicked on a class/method line - show code"
 |string classString selectorString|
 string := classMethodListView selectionValue.
 ].
 currentClass isNil ifTrue:[
 	self warn:'oops class is gone'
 ] ifFalse:[
 	currentClassCategory := currentClass category.
-	currentMethod := actualClass compiledMethodAt:(selectorString asSymbol).
+	currentSelector := selectorString asSymbol.
+	currentMethod := actualClass compiledMethodAt:currentSelector.
 	currentMethodCategory := currentMethod category.
 	self methodSelectionChanged
 ]
 ! !
-!SystemBrowser methodsFor:'class category menu'!
+!SystemBrowser methodsFor:'class category list menu'!
 initializeClassCategoryMenu
 |labels|
 labels := resources array:#(
 					 classCategoryRemove)
 			      receiver:self
 				   for:classCategoryListView)
 !
-allClassesInCurrentCategoryInOrderDo:aBlock
-"evaluate aBlock for all classes in the current class category;
-superclasses come first - then subclasses"
-|classes|
-currentClassCategory notNil ifTrue:[
-	classes := OrderedCollection new.
-	Smalltalk allClassesDo:[:aClass |
-	    aClass isMeta ifFalse:[
-		(aClass category = currentClassCategory) ifTrue:[
-		    classes add:aClass
-		]
-	    ]
-	].
-	classes topologicalSort:[:a :b | b isSubclassOf:a].
-	classes do:aBlock
-]
-!
-allClassesInCurrentCategoryDo:aBlock
-"evaluate aBlock for all classes in the current class category;
-superclasses come first - then subclasses"
-currentClassCategory notNil ifTrue:[
-	Smalltalk allClassesDo:[:aClass |
-	    aClass isMeta ifFalse:[
-		(aClass category = currentClassCategory) ifTrue:[
-		    aBlock value:aClass
-		]
-	    ]
-	].
-]
-!
 classCategoryUpdate
 "update class category list and dependants"
 |oldClassName oldMethodCategory|
 	aClass printOutOn:printStream.
 	printStream close
 ]
 !
+classCategorySpawn
+"create a new SystemBrowser browsing current classCategory"
+currentClassCategory notNil ifTrue:[
+	self withWaitCursorDo:[
+	    self class browseClassCategory:currentClassCategory
+	]
+]
+!
 classCategoryFileOut
 "create a file 'categoryName' consisting of all classes in current category"
 |aStream fileName|
 aStream := FileStream newFileNamed:fileName.
 aStream isNil ifTrue:[
 	^ self warn:'cannot create: %1' with:fileName
 ].
 self withWaitCursorDo:[
-	self label:('System Browser writing: ' , fileName).
+	self busyLabel:'writing: %1' with:fileName.
 	self allClassesInCurrentCategoryInOrderDo:[:aClass |
 	    aClass fileOutOn:aStream.
 	].
 	aStream close.
 	self normalLabel.
+]
+!
+classCategorySpawnFullClass
+"create a new SystemBrowser browsing full class"
+|newBrowser|
+self withWaitCursorDo:[
+	newBrowser := self class browseFullClasses
+" "
+	.
+	currentClass notNil ifTrue:[
+	    newBrowser switchToClassNamed:(currentClass name)
+	]
+" "
 ]
 !
 classCategoryFileOutEach
 self withWaitCursorDo:[
 	self allClassesInCurrentCategoryDo:[:aClass |
-	    self label:('System Browser saving: ' , aClass name).
+	    self busyLabel:'saving: ' with:aClass name.
 	    Class fileOutErrorSignal handle:[:ex |
 		self warn:'cannot create: %1' with:ex parameter.
 		ex return.
 	    ] do:[
 		aClass fileOut
 	].
 	self normalLabel.
 ]
 !
-classCategorySpawn
-"create a new SystemBrowser browsing current classCategory"
-currentClassCategory notNil ifTrue:[
-	self withWaitCursorDo:[
-	    self class browseClassCategory:currentClassCategory
-	]
-]
-!
-classCategorySpawnFullClass
-"create a new SystemBrowser browsing full class"
-|newBrowser|
-self withWaitCursorDo:[
-	newBrowser := self class browseFullClasses
-"
-	.
-	currentClass notNil ifTrue:[
-	    newBrowser switchToClassNamed:(currentClass name)
-	]
-"
-]
-!
 classCategoryNewCategory
 |box|
 box := self enterBoxTitle:'name of new class category:' okText:'create'.
 box action:[:aString |
 	|categories|
-	categories := classCategoryListView list.
+	currentClass notNil ifTrue:[
+	    categories := OrderedCollection new.
+	    currentClass withAllSuperclasses do:[:aClass |
+		aClass methodArray do:[:aMethod |
+		    (categories includes:aMethod category) ifFalse:[
+			categories add:aMethod category
+		    ]
+		]
+	    ].
+	].
+	categories isNil ifTrue:[
+	    categories := classCategoryListView list.
+	].
 	(categories includes:aString) ifFalse:[
 	    categories add:aString.
 	    categories sort.
 	    classCategoryListView setContents:categories.
 	    currentClassCategory := aString.
 	]
 ].
 box showAtPointer
 !
-switchToClassNamed:aString
-|classSymbol theClass|
-classSymbol := aString asSymbol.
-theClass := Smalltalk at:classSymbol.
-theClass isBehavior ifTrue:[
-	classCategoryListView notNil ifTrue:[
-	    currentClassHierarchy isNil ifTrue:[
-		(theClass category ~~ currentClassCategory) ifTrue:[
-		    currentClassCategory := theClass category.
-		    currentClassCategory isNil ifTrue:[
-			classCategoryListView selectElement:'* no category *'
-		    ] ifFalse:[
-			classCategoryListView selectElement:currentClassCategory
-		    ].
-		    self classCategorySelectionChanged
-		]
-	    ]
-	].
-	self switchToClass:theClass.
-	classListView selectElement:aString.
-	self classSelectionChanged
-]
-!
-switchToClassNameMatching:aMatchString
-|classNames thisName box|
-classNames := OrderedCollection new.
-Smalltalk allBehaviorsDo:[:aClass |
-	thisName := aClass name.
-	(aMatchString match:thisName) ifTrue:[
-	    classNames add:thisName
-	]
-].
-(classNames size == 0) ifTrue:[^ nil].
-(classNames size == 1) ifTrue:[
-	^ self switchToClassNamed:(classNames at:1)
-].
-box := self listBoxTitle:'select class to switch to:'
-		      okText:'ok'
-			list:classNames sort.
-box action:[:aString | self switchToClassNamed:aString].
-box showAtPointer
-!
 classCategoryFindClass
 |box|
 box := self enterBoxForCodeSelectionTitle:'class to find:' okText:'find'.
 box action:[:aString | self switchToClassNameMatching:aString].
 box showAtPointer
-!
-renameCurrentClassCategoryTo:aString
-"helper - do the rename"
-|any categories|
-currentClassCategory notNil ifTrue:[
-	any := false.
-	Smalltalk allBehaviorsDo:[:aClass |
-	    aClass category = currentClassCategory ifTrue:[
-		aClass category:aString.
-		any := true
-	    ]
-	].
-	any ifFalse:[
-	    categories := classCategoryListView list.
-	    categories remove:currentClassCategory.
-	    categories add:aString.
-	    categories sort.
-	    classCategoryListView setContents:categories.
-	    currentClassCategory := aString.
-	    classCategoryListView selectElement:aString.
-	] ifTrue:[
-	    currentClassCategory := aString.
-	    self updateClassCategoryList.
-	    self updateClassListWithScroll:false
-	]
-]
 !
 classCategoryRename
 "launch an enterBox to rename current class category"
 	       noText:(resources at:'abort').
 box confirm ifTrue:[
 	"after querying user - do really remove classes in list1 and list2"
 	subclassesRemoved do:[:aClass |
-	    Smalltalk removeClass:aClass
+	    (CheckForInstancesWhenRemovingClasses not
+	    or:[aClass hasInstances not
+	    or:[self confirm:(aClass name , ' has instances - remove anyway ?')]])
+		ifTrue:[
+		    Smalltalk removeClass:aClass
+	    ]
 	].
 	classesToRemove do:[:aClass |
-	    Smalltalk removeClass:aClass
+	    (CheckForInstancesWhenRemovingClasses not
+	    or:[aClass hasInstances not
+	    or:[self confirm:(aClass name , ' has instances - remove anyway ?')]])
+		ifTrue:[
+		    Smalltalk removeClass:aClass
+	    ].
 	].
 	currentClassCategory := nil.
 	self switchToClass:nil.
 	Smalltalk changed
 ]
 ! !
-!SystemBrowser methodsFor:'class menu'!
+!SystemBrowser methodsFor:'method category list menu'!
-initializeClassMenu
-|labels menu varMenu|
-labels := resources array:#(
-					'fileOut'
-					'printOut'
-					'printOut protocol'
-				      " 'printOut full protocol' "
-					'-'
-					'SPAWN_CLASS'
-					'spawn hierarchy'
-					'spawn subclasses'
-					'-'
-					'hierarchy'
-					'definition'
-					'comment'
-					'class instvars'
-				      " 'protocols' "
-					'-'
-"/                                        'variable search'
-					'class refs'
-					'-'
-					'new class'
-					'new subclass'
-					'rename ...'
-					'remove').
-menu := PopUpMenu labels:labels
-		   selectors:#(classFileOut
-			       classPrintOut
-			       classPrintOutProtocol
-			     " classPrintOutFullProtocol "
-			       nil
-			       classSpawn
-			       classSpawnHierarchy
-			       classSpawnSubclasses
-			       nil
-			       classHierarchy
-			       classDefinition
-			       classComment
-			       classClassInstVars
-			     "  classProtocols "
-			       nil
-"/                               variables
-			       classRefs
-			       nil
-			       classNewClass
-			       classNewSubclass
-			       classRename
-			       classRemove)
-		    receiver:self
-			 for:classListView.
-classListView middleButtonMenu:menu.
-varMenu := (PopUpMenu labels:(resources array:#(
-					'instvar refs ...'
-					'classvar refs ...'
-					'all instvar refs ...'
-					'all classvar refs ...'
-					'-'
-					'instvar mods ...'
-					'classvar mods ...'
-					'all instvar mods ...'
-					'all classvar mods ...'
-				     ))
-			   selectors:#(
-					classInstVarRefs
-					classClassVarRefs
-					classAllInstVarRefs
-					classAllClassVarRefs
-					nil
-					classInstVarMods
-					classClassVarMods
-					classAllInstVarMods
-					classAllClassVarMods
-				     )
-			   receiver:self
-				for:self).
-variableListView isNil ifTrue:[
-	menu addLabel:(resources string:'variable search')
-	     selector:#variables
-	     before:#classRefs.
-	menu subMenuAt:#variables put:varMenu.
-] ifFalse:[
-	variableListView middleButtonMenu:varMenu
-].
-!
-checkClassCategorySelected
-currentClassCategory isNil ifTrue:[
-	self warn:'select a class category first'.
-	^ false
-].
-^ true
-!
-checkClassSelected
-currentClass isNil ifTrue:[
-	self warn:'select a class first'.
-	^ false
-].
-^ true
-!
-checkMethodCategorySelected
-currentMethodCategory isNil ifTrue:[
-	self warn:'select a method category first'.
-	^ false
-].
-^ true
-!
-whenMethodCategorySelected:aBlock
-self checkMethodCategorySelected ifTrue:[
-	self withWaitCursorDo:aBlock
-]
-!
-checkMethodSelected
-currentMethod isNil ifTrue:[
-	self warn:'select a method first'.
-	^ false
-].
-^ true
-!
-doClassMenu:aBlock
-"a helper - check if class is selected and evaluate aBlock
-while showing waitCursor"
-self checkClassSelected ifTrue:[
-	self withWaitCursorDo:aBlock
-]
-!
-doClassMenuWithSelection:aBlock
-"a helper - if there is a selection, which represents a classes name,
-evaluate aBlock, passing that class and optional selector as arguments.
-Otherwise, check if a class is selected and evaluate aBlock with the
-current class."
-|string words clsName cls sel isMeta w|
-string := codeView selection.
-string notNil ifTrue:[
-	string := string asString withoutSeparators.
-	words := string asCollectionOfWords.
-	words notNil ifTrue:[
-	    clsName := words first.
-	    (clsName endsWith:'class') ifTrue:[
-		isMeta := true.
-		clsName := clsName copyTo:(clsName size - 5)
-	    ] ifFalse:[
-		isMeta := false
-	    ].
-	    (cls := Smalltalk classNamed:clsName) notNil ifTrue:[
-		sel := Parser selectorInExpression:string.
-		isMeta ifTrue:[
-		    cls := cls class
-		].
-		self withWaitCursorDo:[
-		    aBlock value:cls value:sel.
-		].
-		^ self
-	    ] ifFalse:[
-		self warn:'no class named: %1 - spawning current' with:clsName
-	    ]
-	].
-].
-self doClassMenu:[aBlock value:currentClass value:nil]
-!
-classSpawn
-"create a new SystemBrowser browsing current class,
-or if there is a selection, spawn a browser on the selected class
-even a class/selector pair can be specified."
-|browser|
-self doClassMenuWithSelection:[:cls :sel |
-	cls isMeta ifTrue:[
-	    Smalltalk allClassesDo:[:aClass |
-		aClass class == cls ifTrue:[
-		    browser := self class browseClass:aClass.
-		    browser classProtocol.
-		    sel notNil ifTrue:[
-			browser switchToMethodNamed:sel
-		    ].
-		    ^ self
-		].
-	    ].
-	    self warn:'oops, no class for this metaclass'.
-	    ^ self
-	].
-	browser := self class browseClass:cls.
-	cls hasMethods ifFalse:[
-	    browser classProtocol.
-	].
-	sel notNil ifTrue:[
-	    browser switchToMethodNamed:sel
-	].
-]
-"
-select 'Smalltalk allClassesDo:' and use spawn from the class menu
-select 'Smalltalk'               and use spawn from the class menu
-"
-!
-classSpawnHierarchy
-"create a new HierarchyBrowser browsing current class"
-self doClassMenuWithSelection:[:cls :sel |
-	self class browseClassHierarchy:cls
-]
-!
-classSpawnSubclasses
-"create a new browser browsing current class's subclasses"
-|subs|
-self doClassMenuWithSelection:[:cls :sel |
-	subs := cls allSubclasses.
-	(subs notNil and:[subs size ~~ 0]) ifTrue:[
-	    self class browseClasses:subs title:('subclasses of ' , cls name)
-	]
-]
-!
-classPrintOutFullProtocol
-|printStream|
-self doClassMenu:[
-	printStream := Printer new.
-	currentClass printOutFullProtocolOn:printStream.
-	printStream close
-]
-!
-classPrintOutProtocol
-|printStream|
-self doClassMenu:[
-	printStream := Printer new.
-	currentClass printOutProtocolOn:printStream.
-	printStream close
-]
-!
-classPrintOut
-|printStream|
-self doClassMenu:[
-	printStream := Printer new.
-	currentClass printOutOn:printStream.
-	printStream close
-]
-!
-classFileOut
-self doClassMenu:[
-	self label:('System Browser saving: ' , currentClass name).
-	Class fileOutErrorSignal handle:[:ex |
-	    self warn:'cannot create: %1' with:ex parameter.
-	    ex return.
-	] do:[
-	    currentClass fileOut.
-	].
-	self normalLabel.
-]
-!
-classHierarchy
-"show current classes hierarchy in codeView"
-|aStream|
-self doClassMenu:[
-	aStream := WriteStream on:(String new:200).
-	actualClass printHierarchyOn:aStream.
-	codeView contents:(aStream contents).
-	codeView modified:false.
-	codeView acceptAction:nil.
-	codeView explainAction:nil.
-	methodListView notNil ifTrue:[
-	    methodListView deselect
-	].
-	aspect := #hierarchy
-]
-!
-classDefinition
-"show class definition in codeView and setup accept-action for
-class-definition change"
-|aStream|
-self doClassMenu:[
-	aStream := WriteStream on:(String new:200).
-	currentClass fileOutDefinitionOn:aStream.
-	codeView contents:(aStream contents).
-	codeView modified:false.
-	codeView acceptAction:[:theCode |
-	    codeView cursor:Cursor execute.
-	    Object abortSignal catch:[
-		(Compiler evaluate:theCode asString notifying:codeView)
-		isBehavior ifTrue:[
-		    codeView modified:false.
-		    self classCategoryUpdate.
-		    self updateClassListWithScroll:false.
-		]
-	    ].
-	    codeView cursor:Cursor normal.
-	].
-	codeView explainAction:nil.
-	methodListView notNil ifTrue:[
-	    methodListView deselect
-	].
-	aspect := #definition
-]
-!
-classClassInstVars
-"show class instance variables in codeView and setup accept-action
-for class-instvar-definition change"
-|s|
-self doClassMenu:[
-	s := WriteStream on:(String new).
-	currentClass fileOutClassInstVarDefinitionOn:s.
-	codeView contents:(s contents).
-	codeView modified:false.
-	codeView acceptAction:[:theCode |
-	    codeView cursor:Cursor execute.
-	    Object abortSignal catch:[
-		Compiler evaluate:theCode asString notifying:codeView.
-		codeView modified:false.
-		self updateClassList.
-	    ].
-	    codeView cursor:Cursor normal.
-	].
-	codeView explainAction:nil.
-	methodListView notNil ifTrue:[
-	    methodListView deselect
-	]
-]
-!
-classProtocols
-^ self
-!
-classComment
-"show the classes comment in the codeView"
-self doClassMenu:[
-	codeView contents:(currentClass comment).
-	codeView modified:false.
-	codeView acceptAction:[:theCode |
-	    Object abortSignal catch:[
-		currentClass comment:theCode asString.
-		codeView modified:false.
-	    ]
-	].
-	codeView explainAction:nil.
-	methodListView notNil ifTrue:[
-	    methodListView deselect
-	].
-	aspect := #comment
-]
-!
-classRefs
-self doClassMenu:[
-	self withCursor:(Cursor questionMark) do:[
-	    self class browseReferendsOf:currentClass name asSymbol
-	]
-]
-!
-classClassDefinitionTemplateFor:name in:cat
-"common helper for newClass and newSubclass
-- show a template to define class name in category cat"
-currentMethodCategory := nil.
-currentMethod := nil.
-classListView deselect.
-fullClass ifFalse:[
-	methodCategoryListView contents:nil.
-	methodListView contents:nil
-].
-codeView contents:(self templateFor:name in:cat).
-codeView modified:false.
-codeView acceptAction:[:theCode |
-	codeView cursor:Cursor execute.
-	Object abortSignal catch:[
-	    |cl|
-	    cl := (Compiler evaluate:theCode asString notifying:codeView).
-	    cl isBehavior ifTrue:[
-		codeView modified:false.
-		self classCategoryUpdate.
-		self updateClassListWithScroll:false.
-		self switchToClassNamed:(cl name)
-	    ]
-	].
-	codeView cursor:(Cursor normal).
-].
-codeView explainAction:nil.
-self switchToClass:nil
-!
-classNewClass
-"create a class-definition prototype in codeview"
-|nm|
-currentClass notNil ifTrue:[
-	nm := currentClass superclass name
-] ifFalse:[
-	nm := 'Object'
-].
-self classClassDefinitionTemplateFor:nm in:currentClassCategory.
-aspect := nil
-!
-classNewSubclass
-"create a subclass-definition prototype in codeview"
-self doClassMenu:[
-	self classClassDefinitionTemplateFor:(currentClass name)
-					  in:(currentClass category).
-	aspect := nil
-]
-!
-renameCurrentClassTo:aString
-"helper - do the rename"
-self doClassMenu:[
-	|oldName oldSym newSym|
-	oldName := currentClass name.
-	oldSym := oldName asSymbol.
-"
-	currentClass setName:aString.
-	newSym := aString asSymbol.
-	Smalltalk at:oldSym put:nil.
-	Smalltalk removeKey:oldSym.
-	Smalltalk at:newSym put:currentClass.
-"
-"
-	currentClass renameTo:aString.
-"
-	Smalltalk renameClass:currentClass to:aString.
-	self updateClassList.
-	self updateMethodCategoryListWithScroll:false.
-	self updateMethodListWithScroll:false.
-	self withWaitCursorDo:[
-	    Transcript showCr:('searching for users of ' , oldSym); endEntry.
-	    self class browseReferendsOf:oldSym warnIfNone:false
-	]
-]
-!
-classRename
-"launch an enterBox for new name and query user"
-|box|
-self checkClassSelected ifFalse:[^ self].
-box := self enterBoxTitle:(resources string:'rename %1 to:' with:currentClass name) okText:'rename'.
-box initialText:(currentClass name).
-box action:[:aString | self renameCurrentClassTo:aString].
-box showAtPointer
-!
-classRemove
-"user requested remove of current class and all subclasses -
-count subclasses and let user confirm removal."
-|count t box|
-currentClass notNil ifTrue:[
-	count := currentClass allSubclasses size.
-	t := 'remove ' , currentClass name.
-	count ~~ 0 ifTrue:[
-	   t := t , '\(with ' , count printString , ' subclass'.
-	   count ~~ 1 ifTrue:[
-		t := t , 'es'
-	   ].
-	   t := (t , ')') withCRs
-	].
-	box := YesNoBox
-		   title:t
-		   yesText:(resources at:'remove')
-		   noText:(resources at:'abort').
-	box confirm ifTrue:[
-	    "after querying user - do really remove current class
-	     and all subclasses
-	    "
-	    self doClassMenu:[
-		currentClass allSubclassesDo:[:aSubClass |
-		    Smalltalk removeClass:aSubClass
-		].
-		Smalltalk removeClass:currentClass.
-		self switchToClass:nil.
-		Smalltalk changed.
-		self updateClassList.
-		"if it was the last in its category, update class category list"
-"
-		classListView numberOfLines == 0 ifTrue:[
-		    self updateClassCategoryListWithScroll:false
-		].
-"
-		methodCategoryListView notNil ifTrue:[methodCategoryListView contents:nil].
-		methodListView notNil ifTrue:[methodListView contents:nil].
-		codeView contents:nil.
-		codeView modified:false
-	    ]
-	]
-]
-! !
-!SystemBrowser methodsFor:'variables menu'!
-enterBoxForVariableSearch:title
-|box sel|
-box := self enterBoxForCodeSelectionTitle:title okText:'browse'.
-variableListView notNil ifTrue:[
-	codeView hasSelection ifFalse:[
-	    (sel := variableListView selectionValue) notNil ifTrue:[
-		(sel startsWith:'---') ifFalse:[
-		    box initialText:sel
-		]
-	    ]
-	]
-].
-^ box
-!
-classInstVarRefsOrModsTitle:title mods:mods
-"show an enterbox for instvar to search for"
-self doClassMenu:[
-	|box|
-	box := self enterBoxForVariableSearch:title.
-	box action:[:aString |
-	    self withCursor:(Cursor questionMark) do:[
-		self class browseInstRefsTo:aString
-					 in:(Array with:currentClass)
-			  modificationsOnly:mods
-	    ]
-	].
-	box showAtPointer
-]
-!
-classInstVarRefs
-"show an enterbox for instVar to search for"
-self classInstVarRefsOrModsTitle:'instance variable to browse references to:'
-				mods:false
-!
-classInstVarMods
-"show an enterbox for instVar to search for"
-self classInstVarRefsOrModsTitle:'instance variable to browse modifications of:'
-				mods:true
-!
-classClassVarRefsOrModsTitle:title mods:mods
-"show an enterbox for classVar to search for"
-self doClassMenu:[
-	|box|
-	box := self enterBoxForVariableSearch:title.
-	box action:[:aString |
-	    self withCursor:(Cursor questionMark) do:[
-		self class browseClassRefsTo:aString
-					  in:(Array with:currentClass)
-			   modificationsOnly:mods
-	    ]
-	].
-	box showAtPointer
-]
-!
-classClassVarMods
-"show an enterbox for classVar to search for"
-self classClassVarRefsOrModsTitle:'class variable to browse modifications of:'
-				 mods:true
-!
-classClassVarRefs
-"show an enterbox for classVar to search for"
-self classClassVarRefsOrModsTitle:'class variable to browse references to:'
-				 mods:false
-!
-classAllClassOrInstVarRefsTitle:title access:access mods:modifications
-"show an enterbox for instVar to search for"
-self doClassMenu:[
-	|box|
-	box := self enterBoxForVariableSearch:title.
-	box action:[:aVariableName |
-	    self withCursor:(Cursor questionMark) do:[
-		|homeClass|
-		homeClass := self findClassOfVariable:aVariableName
-					   accessWith:access.
-		(self class) browseInstRefsTo:aVariableName
-					under:homeClass
-			    modificationsOnly:modifications
-	    ]
-	].
-	box showAtPointer
-]
-!
-classAllInstVarRefs
-"show an enterbox for instVar to search for"
-self classAllClassOrInstVarRefsTitle:'instance variable to browse references to:'
-				  access:#instVarNames
-				  mods:false
-!
-classAllClassVarRefs
-"show an enterbox for classVar to search for"
-self classAllClassOrInstVarRefsTitle:'class variable to browse references to:'
-				  access:#classVarNames
-				  mods:false
-!
-classAllInstVarMods
-"show an enterbox for instVar to search for"
-self classAllClassOrInstVarRefsTitle:'instance variable to browse modifications of:'
-				  access:#instVarNames
-				  mods:true
-!
-classAllClassVarMods
-"show an enterbox for classVar to search for"
-self classAllClassOrInstVarRefsTitle:'class variable to browse modifications of:'
-				  access:#classVarNames
-				  mods:true
-! !
-!SystemBrowser methodsFor:'method category menu'!
 initializeMethodCategoryMenu
 |labels|
 labels := resources array:#(
 					 methodCategoryRemove)
 			      receiver:self
 				   for:methodCategoryListView)
 !
-switchToMethodNamed:matchString
+methodCategoryFindAnyMethod
-|aSelector method cat index classToSearch selectors|
+|box|
-currentClass notNil ifTrue:[
+box := self enterBoxForSearchSelectorTitle:'method selector to search for:'.
-	showInstance ifTrue:[
+box action:[:aString | self switchToAnyMethodNamed:aString].
-	    classToSearch := currentClass
+box showAtPointer
-	] ifFalse:[
-	    classToSearch := currentClass class
-	].
-	selectors := classToSearch selectorArray.
-	((matchString ~= '*') and:[matchString includesMatchCharacters]) ifTrue:[
-	    index := selectors findFirst:[:element | matchString match:element]
-	] ifFalse:[
-	    index := selectors indexOf:matchString
-	].
-	(index ~~ 0) ifTrue:[
-	    aSelector := selectors at:index.
-	    method := classToSearch methodArray at:index.
-	    cat := method category.
-	    cat isNil ifTrue:[cat := '* all *'].
-	    methodCategoryListView selectElement:cat.
-	    currentMethodCategory := cat.
-	    self methodCategorySelectionChanged.
-	    currentMethod := classToSearch compiledMethodAt:aSelector.
-	    methodListView selectElement:aSelector.
-	    self methodSelectionChanged
-	]
-]
-!
-switchToAnyMethodNamed:aString
-|aSelector classToStartSearch aClass nm|
-aSelector := aString asSymbol.
-currentClass isNil ifTrue:[
-	currentClassHierarchy notNil ifTrue:[
-	    classToStartSearch := currentClassHierarchy
-	]
-] ifFalse:[
-	classToStartSearch := currentClass
-].
-classToStartSearch notNil ifTrue:[
-	showInstance ifFalse:[
-	    classToStartSearch := classToStartSearch class
-	].
-	aClass := classToStartSearch whichClassImplements:aSelector.
-	aClass notNil ifTrue:[
-	    nm := aClass name.
-	    showInstance ifFalse:[
-		((nm ~= 'Metaclass') and:[nm endsWith:'class']) ifTrue:[
-		    nm := nm copyTo:(nm size - 5)
-		]
-	    ].
-	    self switchToClassNamed:nm.
-	    self switchToMethodNamed:aString
-	]
-]
-!
-copyMethodsFromClass:aClassName
-|class box|
-currentClass notNil ifTrue:[
-	Symbol hasInterned:aClassName ifTrue:[:sym |
-	    (Smalltalk includesKey:sym) ifTrue:[
-		class := Smalltalk at:sym
-	    ].
-	].
-	class isBehavior ifFalse:[
-	    self warn:'no class named %1' with:aClassName.
-	    ^ self
-	].
-	showInstance ifFalse:[
-	    class := class class
-	].
-	"show enterbox for category to copy from"
-	box := self enterBoxTitle:'name of category to copy from (matchpattern allowed, * for all):'
-			   okText:'copy'.
-	box action:[:aString | self copyMethodsFromClass:class category:aString].
-	box showAtPointer.
-]
-!
-copyMethodsFromClass:class category:category
-|source|
-currentClass notNil ifTrue:[
-"/        codeView abortAction:[^ self].
-	Object abortSignal catch:[
-	    class methodArray do:[:aMethod |
-		(category match:aMethod category) ifTrue:[
-		    source := aMethod source.
-		    codeView contents:source.
-		    codeView modified:false.
-		    actualClass compiler compile:source
-					forClass:actualClass
-				      inCategory:aMethod category
-				       notifying:codeView.
-		    self updateMethodCategoryListWithScroll:false.
-		    self updateMethodListWithScroll:false.
-		]
-	    ]
-	]
-]
 !
 methodCategoryFindMethod
 |box|
 box := self enterBoxForSearchSelectorTitle:'method selector to search for:'.
 box action:[:aString | self switchToMethodNamed:aString].
-box showAtPointer
-!
-methodCategoryFindAnyMethod
-|box|
-box := self enterBoxForSearchSelectorTitle:'method selector to search for:'.
-box action:[:aString | self switchToAnyMethodNamed:aString].
 box showAtPointer
 !
 methodCategoryPrintOut
 |printStream|
 "fileOut all methods in the selected methodcategory of
 the current class"
 self checkClassSelected ifFalse:[^ self].
 self whenMethodCategorySelected:[
-	self label:('System Browser saving: ' , currentClass name , '-' , currentMethodCategory).
+	self busyLabel:'saving: %1' with:currentClass name , '-' , currentMethodCategory.
 	Class fileOutErrorSignal handle:[:ex |
 	    self warn:'cannot create: %1' with:ex parameter.
 	    ex return.
 	] do:[
 	    actualClass fileOutCategory:currentMethodCategory.
 	].
 	self normalLabel.
+]
+!
+methodCategorySpawn
+"create a new SystemBrowser browsing current method category"
+currentMethodCategory notNil ifTrue:[
+	self withWaitCursorDo:[
+	    self class browseClass:actualClass
+		    methodCategory:currentMethodCategory
+	]
 ]
 !
 methodCategoryFileOutAll
 "fileOut all methods in the selected methodcategory of
 	outStream := FileStream newFileNamed:fileName.
 	outStream isNil ifTrue:[
 	    ^ self warn:'cannot create: %1' with:fileName
 	].
-	self label:('System Browser saving: ' , currentMethodCategory).
+	self busyLabel:'saving: ' with:currentMethodCategory.
 	Class fileOutErrorSignal handle:[:ex |
 	    self warn:'cannot create: %1' with:ex parameter.
 	    ex return
 	] do:[
-	    Smalltalk allClassesDo:[:class |
+	    Smalltalk allBehaviorsDo:[:class |
 		|hasMethodsInThisCategory|
 		hasMethodsInThisCategory := false.
 		class methodArray do:[:method |
 		    method category = currentMethodCategory ifTrue:[
 	outStream close.
 	self normalLabel.
 ].
 !
-methodCategorySpawn
-"create a new SystemBrowser browsing current method category"
-currentMethodCategory notNil ifTrue:[
-	self withWaitCursorDo:[
-	    self class browseClass:actualClass
-		    methodCategory:currentMethodCategory
-	]
-]
-!
-methodCategorySpawnCategory
-"create a new SystemBrowser browsing all methods from all
-classes with same category as current method category"
-self askAndBrowseMethodCategory:'category to browse methods:'
-			     action:[:aString |
-					self class browseMethodCategory:aString
-				    ]
-!
-newMethodCategory:aString
-|categories|
-currentClass isNil ifTrue:[
-	^ self warn:'select/create a class first'.
-].
-categories := methodCategoryListView list.
-categories isNil ifTrue:[categories := Text new].
-(categories includes:aString) ifFalse:[
-	categories add:aString.
-	categories sort.
-	methodCategoryListView contents:categories
-].
-currentMethodCategory := aString.
-self methodCategorySelectionChanged
-!
 methodCategoryNewCategory
-"show the enter box to add a new method category"
+"show the enter box to add a new method category.
+Offer existing superclass categories in box to help avoiding
+useless typing."
 |someCategories existingCategories box|
-"a tiny little goody here ..."
+actualClass notNil ifTrue:[
-showInstance ifTrue:[
+	someCategories := actualClass allCategories
-	someCategories := #('accessing'
-			    'initialization'
-			    'private'
-			    'printing & storing'
-			    'queries'
-			    'testing'
-			   )
 ] ifFalse:[
-	someCategories := #(
+	"
-			    'documentation'
+	 mhmh - offer some typical categories ...
-			    'initialization'
+	"
-			    'instance creation'
+	showInstance ifTrue:[
-			   ).
+	    someCategories := #('accessing'
-].
+				'initialization'
+				'private'
+				'printing & storing'
+				'queries'
+				'testing'
+			       )
+	] ifFalse:[
+	    someCategories := #(
+				'documentation'
+				'initialization'
+				'instance creation'
+			       ).
+	].
+].
+someCategories sort.
+"
+remove existing categories
+"
 existingCategories := methodCategoryListView list.
 existingCategories notNil ifTrue:[
 	someCategories := someCategories select:[:cat | (existingCategories includes:cat) not].
 ].
 box := self listBoxTitle:'name of new method category:'
 		      okText:'create'
 			list:someCategories.
 box action:[:aString | self newMethodCategory:aString].
 box showAtPointer
+!
+methodCategorySpawnCategory
+"create a new SystemBrowser browsing all methods from all
+classes with same category as current method category"
+self askAndBrowseMethodCategory:'category to browse methods:'
+			     action:[:aString |
+					self class browseMethodCategory:aString
+				    ]
 !
 methodCategoryCreateAccessMethods
 "create access methods for all instvars"
-|source|
 self checkClassSelected ifFalse:[^ self].
 showInstance ifFalse:[
 	self warn:'select instance - and try again'.
 	^ self.
 ].
 self withWaitCursorDo:[
-	currentClass instVarNames do:[:name |
+	|nm names source|
+	(variableListView notNil
+	and:[(nm := variableListView selectionValue) notNil]) ifTrue:[
+	    names := Array with:nm
+	] ifFalse:[
+	    names := currentClass instVarNames
+	].
+	names do:[:name |
 	    "check, if method is not already present"
 	    (currentClass implements:(name asSymbol)) ifFalse:[
 		source := (name , '\    "return ' , name , '"\\    ^ ' , name) withCRs.
 		Compiler compile:source forClass:currentClass inCategory:'accessing'.
 	    ] ifTrue:[
 		okText:(resources at:'rename').
 box initialText:currentMethodCategory.
 box action:[:aString |
 	actualClass renameCategory:currentMethodCategory to:aString.
 	currentMethodCategory := aString.
-	currentMethod := nil.
+	currentMethod := currentSelector := nil.
 	self updateMethodCategoryList.
 	self updateMethodListWithScroll:false
 ].
 box showAtPointer
 !
 		count := count + 1
 	    ]
 	].
 	(count == 0) ifTrue:[
 	    currentMethodCategory := nil.
-	    currentMethod := nil.
+	    currentMethod := currentSelector := nil.
 	    self updateMethodCategoryListWithScroll:false.
 	    self updateMethodList
 	] ifFalse:[
 	    (count == 1) ifTrue:[
 		t := resources string:'remove %1 ?\(with 1 method)' with:currentMethodCategory
 			actualClass
 			    removeSelector:(actualClass selectorForMethod:aMethod)
 		    ]
 		].
 		currentMethodCategory := nil.
-		currentMethod := nil.
+		currentMethod := currentSelector := nil.
 		self updateMethodCategoryList.
 		self updateMethodList
 	    ]
 	]
 ]
 ! !
-!SystemBrowser methodsFor:'method menu'!
+!SystemBrowser methodsFor:'method list menu'!
+methodMenu
+"return a popupmenu as appropriate for the methodList"
+|labels selectors|
+(currentMethod notNil and:[currentMethod isWrapped]) ifTrue:[
+	labels := #(
+			'fileOut'
+			'printOut'
+			'-'
+			'SPAWN_METHOD'
+			'-'
+			'senders ...'
+			'implementors ...'
+			'globals ...'
+"
+			'strings ...'
+			'apropos ...'
+"
+			'-'
+			'local senders ...'
+			'local implementors ...'
+"
+			'local strings ...'
+"
+			'-'
+			'remove break/trace'
+			'-'
+			'new method'
+			'change category ...'
+			'remove'
+		    ).
+	selectors := #(
+			methodFileOut
+			methodPrintOut
+			nil
+			methodSpawn
+			nil
+			methodSenders
+			methodImplementors
+			methodGlobalReferends
+"
+			methodStringSearch
+			methodAproposSearch
+"
+			nil
+			methodLocalSenders
+			methodLocalImplementors
+"
+			methodLocalStringSearch
+"
+			nil
+			methodRemoveBreakOrTrace
+			nil
+			methodNewMethod
+			methodChangeCategory
+			methodRemove
+		      )
+] ifFalse:[
+	labels := #(
+			'fileOut'
+			'printOut'
+			'-'
+			'SPAWN_METHOD'
+			'-'
+			'senders ...'
+			'implementors ...'
+			'globals ...'
+"
+			'strings ...'
+			'apropos ...'
+"
+			'-'
+			'local senders ...'
+			'local implementors ...'
+"
+			'local strings ...'
+"
+			'-'
+			'breakpoint'
+			'trace'
+			'trace sender'
+			'-'
+			'new method'
+			'change category ...'
+			'remove'
+		    ).
+	selectors := #(
+			methodFileOut
+			methodPrintOut
+			nil
+			methodSpawn
+			nil
+			methodSenders
+			methodImplementors
+			methodGlobalReferends
+"
+			methodStringSearch
+			methodAproposSearch
+"
+			nil
+			methodLocalSenders
+			methodLocalImplementors
+"
+			methodLocalStringSearch
+"
+			nil
+			methodBreakPoint
+			methodTrace
+			methodTraceSender
+			nil
+			methodNewMethod
+			methodChangeCategory
+			methodRemove
+		      )
+].
+^ PopUpMenu
+	 labels:(resources array:labels)
+	 selectors:selectors
+	 receiver:self
+	 for:methodListView
+!
 initializeMethodMenu
 |labels|
+methodListView model:self.
+methodListView menu:#methodMenu.
+^ self.
 labels := resources array:#(
 					 'fileOut'
 					 'printOut'
 					 '-'
 					 methodRemove)
 			      receiver:self
 				   for:methodListView)
 !
+methodImplementors
+"launch an enterBox for selector to search for"
+self askAndBrowseSelectorTitle:'selector to browse implementors of:'
+			    action:[:aString |
+				       self class browseImplementorsOf:aString
+				   ]
+!
+methodSenders
+"launch an enterBox for selector to search for"
+self askAndBrowseSelectorTitle:'selector to browse senders of:'
+			    action:[:aString |
+				       self class browseAllCallsOn:aString
+				   ]
+!
+methodRemove
+"remove the current method"
+self checkMethodSelected ifFalse:[^ self].
+actualClass removeSelector:(actualClass selectorForMethod:currentMethod).
+currentMethod := currentSelector := nil.
+self updateMethodListWithScroll:false
+!
 initializeMethodMenu2
 |labels|
 methodListView isNil ifTrue:[^ self].
+^self.
 labels := resources array:#(
 					 'fileOut'
 					 'printOut'
 					 '-'
 					 'SPAWN_METHOD'
 					 methodRemove)
 			      receiver:self
 				   for:methodListView)
 !
+methodLocalSenders
+"launch an enterBox for selector to search for in current class & subclasses"
+self checkClassSelected ifFalse:[^ self].
+self askAndBrowseSelectorTitle:'selector to browse local senderss of:'
+			    action:[:aString |
+				       self class browseCallsOn:aString under:currentClass
+				   ]
+!
 methodPrintOut
 "print out the current method"
 |printStream|
 self checkMethodSelected ifFalse:[^ self].
 printStream := Printer new.
-actualClass printOutSource:currentMethod source on:printStream.
+actualClass printOutSource:(currentMethod source) on:printStream.
 printStream close
+!
+methodLocalImplementors
+"launch an enterBox for selector to search for"
+self checkClassSelected ifFalse:[^ self].
+self askAndBrowseSelectorTitle:'selector to browse local implementors of:'
+			    action:[:aString |
+				       self class browseImplementorsOf:aString under:currentClass
+				   ]
+!
+methodGlobalReferends
+"launch an enterBox for global symbol to search for"
+self enterBoxForBrowseTitle:'global variable to browse users of:'
+			 action:[:aString |
+				    self class browseReferendsOf:aString asSymbol
+				]
+!
+methodSpawn
+"create a new SystemBrowser browsing current method,
+or if the current selection is of the form 'class>>selector', spawan
+a browser on that method."
+|s sel selSymbol clsName clsSymbol cls meta isMeta w sep|
+classMethodListView notNil ifTrue:[
+	s := classMethodListView selectionValue.
+	clsName := self classFromClassMethodString:s.
+	sel := self selectorFromClassMethodString:s.
+	isMeta := false
+].
+self extractClassAndSelectorFromSelectionInto:[:c :s :m |
+	clsName := c.
+	sel := s.
+	isMeta := m
+].
+(sel notNil and:[clsName notNil]) ifTrue:[
+	(clsName knownAsSymbol and:[sel knownAsSymbol]) ifTrue:[
+	    clsSymbol := clsName asSymbol.
+	    (Smalltalk includesKey:clsSymbol) ifTrue:[
+		cls := Smalltalk at:clsSymbol.
+		isMeta ifTrue:[
+		    cls := cls class
+		].
+		cls isBehavior ifFalse:[
+		    cls := cls class
+		].
+		cls isBehavior ifTrue:[
+		    selSymbol := sel asSymbol.
+		    self withWaitCursorDo:[
+			(cls implements:selSymbol) ifFalse:[
+			    cls := cls class.
+			].
+			(cls implements:selSymbol) ifTrue:[
+			    self class browseClass:cls selector:selSymbol.
+			    ^ self
+			].
+			w := ' does not implement #' , sel
+		    ]
+		] ifFalse:[
+		    w := ' is not a class'
+		]
+	    ] ifFalse:[
+		w := ' is unknown'
+	    ]
+	] ifFalse:[
+	    w := ' and/or ' , sel , ' are unknown'
+	].
+	self warn:(clsName , w).
+	^ self
+].
+self checkMethodSelected ifFalse:[
+	self warn:'select a method first'.
+	^ self
+].
+self withWaitCursorDo:[
+	w := currentMethod who.
+	self class browseClass:(w at:1) selector:(w at:2)
+]
 !
 methodFileOut
 "file out the current method"
 self checkMethodSelected ifFalse:[^ self].
-self label:'System Browser saving'.
+self busyLabel:'saving:' with:currentSelector.
 Class fileOutErrorSignal handle:[:ex |
 	self warn:'cannot create: %1' with:ex parameter.
 	ex return
 ] do:[
 	actualClass fileOutMethod:currentMethod.
 ].
 self normalLabel.
 !
-methodImplementors
+methodChangeCategory
-"launch an enterBox for selector to search for"
+"move the current method into another category -
+nothing done here, but a query for the new category.
-self askAndBrowseSelectorTitle:'selector to browse implementors of:'
+Remember the last category, to allow faster category change of a group of methods."
-			    action:[:aString |
-				       self class browseImplementorsOf:aString
+|box txt|
-				   ]
-!
+self checkMethodSelected ifFalse:[^ self].
-methodLocalImplementors
+actualClass isNil ifTrue:[
-"launch an enterBox for selector to search for"
+	box := self enterBoxTitle:'' okText:'change'.
+] ifFalse:[
-self checkClassSelected ifFalse:[^ self].
+	|someCategories|
-self askAndBrowseSelectorTitle:'selector to browse local implementors of:'
-			    action:[:aString |
+	someCategories := actualClass categories sort.
-				       self class browseImplementorsOf:aString under:currentClass
+	box := self listBoxTitle:'' okText:'change' list:someCategories.
-				   ]
+].
-!
+box title:('change category from ''' , currentMethod category , ''' to:').
+lastMethodCategory isNil ifTrue:[
-methodSenders
+	txt := currentMethod category.
-"launch an enterBox for selector to search for"
+] ifFalse:[
+	txt := lastMethodCategory
-self askAndBrowseSelectorTitle:'selector to browse senders of:'
+].
-			    action:[:aString |
+box initialText:txt.
-				       self class browseAllCallsOn:aString
+box action:[:aString |
-				   ]
+		    lastMethodCategory := aString.
-!
+		    currentMethod category:aString asSymbol.
-methodLocalSenders
+		    currentClass changed.
-"launch an enterBox for selector to search for in current class & subclasses"
+		    currentMethod changed:#category.
+		    currentClass addChangeRecordForMethodCategory:currentMethod category:aString.
-self checkClassSelected ifFalse:[^ self].
+		    self updateMethodCategoryListWithScroll:false.
-self askAndBrowseSelectorTitle:'selector to browse local senderss of:'
+		    self updateMethodListWithScroll:false
-			    action:[:aString |
+	       ].
-				       self class browseCallsOn:aString under:currentClass
+box showAtPointer
-				   ]
-!
-methodGlobalReferends
-"launch an enterBox for global symbol to search for"
-self enterBoxForBrowseTitle:'global variable to browse users of:'
-			 action:[:aString |
-				    self class browseReferendsOf:aString asSymbol
-				]
 !
 methodStringSearch
 "launch an enterBox for (sub)-string to search for"
 			    action:[:aString |
 				       self class aproposSearch:aString
 				   ]
 !
-methodSpawn
-"create a new SystemBrowser browsing current method,
-or if the current selection is of the form 'class>>selector', spwan
-a browser on that method."
-|s sel selSymbol clsName clsSymbol cls meta browseMeta w sep|
-sel := codeView selection.
-sel notNil ifTrue:[
-	sel := sel asString withoutSeparators.
-	('*>>*' match:sel) ifTrue:[
-	    sep := $>
-	] ifFalse:[
-	    ('* *' match:sel) ifTrue:[
-		sep := Character space
-	    ]
-	].
-	sep notNil ifTrue:[
-	    "
-	     extract class/sel from selection
-	    "
-	    s := ReadStream on:sel.
-	    clsName := s upTo:sep.
-	    [s peek == sep] whileTrue:[s next].
-	    sel := s upToEnd.
-	    (clsName endsWith:'class') ifTrue:[
-		browseMeta := true.
-		clsName := clsName copyTo:(clsName size - 5)
-	    ] ifFalse:[
-		browseMeta := false
-	    ].
-	    (clsName knownAsSymbol and:[sel knownAsSymbol]) ifTrue:[
-		clsSymbol := clsName asSymbol.
-		(Smalltalk includesKey:clsSymbol) ifTrue:[
-		    cls := Smalltalk at:clsSymbol.
-		    browseMeta ifTrue:[
-			cls := cls class
-		    ].
-		    cls isBehavior ifFalse:[
-			cls := cls class
-		    ].
-		    cls isBehavior ifTrue:[
-			selSymbol := sel asSymbol.
-			self withWaitCursorDo:[
-			    (cls implements:selSymbol) ifTrue:[
-				self class browseClass:cls selector:selSymbol.
-				^ self
-			    ] ifFalse:[
-				meta := cls class.
-				(meta implements:selSymbol) ifTrue:[
-				    self class browseClass:meta selector:selSymbol.
-				    ^ self
-				].
-				w := ' does not implement #' , sel
-			    ]
-			]
-		    ] ifFalse:[
-			w := ' is not a class'
-		    ]
-		] ifFalse:[
-		    w := ' is unknown'
-		]
-	    ] ifFalse:[
-		w := ' and/or ' , sel , ' is unknown'
-	    ].
-	    self warn:(clsName , w).
-	    ^ self
-	].
-].
-self checkMethodSelected ifFalse:[^ self].
-self withWaitCursorDo:[
-	self class browseClass:actualClass
-		      selector:(actualClass selectorForMethod:currentMethod)
-]
-!
 methodNewMethod
 "prepare for definition of a new method - put a template into
 code view and define accept-action to compile it"
 currentClass isNil ifTrue:[
 ].
 currentMethodCategory isNil ifTrue:[
 	^ self warn:'select/create a method category first'.
 ].
-currentMethod := nil.
+currentMethod := currentSelector := nil.
 methodListView deselect.
 codeView contents:(self template).
 codeView modified:false.
-codeView acceptAction:[:theCode |
+self setAcceptAndExplainActionsForMethod.
-	codeView cursor:Cursor execute.
+!
-	Object abortSignal catch:[
-	    actualClass compiler compile:theCode asString
+methodTrace
-				forClass:actualClass
+"turn on tracing of the current method"
-			      inCategory:currentMethodCategory
-			       notifying:codeView.
+|sel|
-	    codeView modified:false.
-	    self updateMethodListWithScroll:false.
+currentClass notNil ifTrue:[
-	].
+currentSelector notNil ifTrue:[
-	codeView cursor:Cursor normal.
+currentMethod := actualClass compiledMethodAt:currentSelector
-].
+]
-codeView explainAction:[:theCode :theSelection |
+].
-	self showExplanation:(Explainer explain:theSelection
-					     in:theCode
+(currentMethod notNil and:[currentMethod isWrapped not])
-				       forClass:actualClass)
+ifTrue:[
-]
+	currentMethod := MessageTracer traceMethod:currentMethod.
-!
+	sel := methodListView selection.
+	self updateMethodListWithScroll:false.
-methodRemove
+	methodListView selection:sel.
-"remove the current method"
+	currentClass changed:#methodDictionary with:currentSelector.
+]
-self checkMethodSelected ifFalse:[^ self].
-actualClass removeSelector:(actualClass selectorForMethod:currentMethod).
-self updateMethodListWithScroll:false
-!
-methodChangeCategory
-"move the current method into another category -
-nothing done here, but a query for the new category.
-Remember the last category, to allow faster category change of a group of methods."
-|box txt|
-self checkMethodSelected ifFalse:[^ self].
-box := self enterBoxTitle:('change category from ' , currentMethod category , ' to:')
-		okText:'change'.
-lastMethodCategory isNil ifTrue:[
-	txt := currentMethod category.
-] ifFalse:[
-	txt := lastMethodCategory
-].
-box initialText:txt.
-box action:[:aString |
-		    lastMethodCategory := aString.
-		    currentMethod category:aString asSymbol.
-		    currentClass changed.
-		    self updateMethodCategoryListWithScroll:false.
-		    self updateMethodListWithScroll:false
-	       ].
-box showAtPointer
 !
 methodRemoveBreakOrTrace
 "turn off tracing of the current method"
 |sel|
-currentMethod notNil ifTrue:[
+(currentMethod notNil and:[currentMethod isWrapped])
-	currentMethod isWrapped ifTrue:[
+ifTrue:[
-	    currentMethod := MessageTracer unwrapMethod:currentMethod.
+	currentMethod := MessageTracer unwrapMethod:currentMethod.
-	    sel := methodListView selection.
+	sel := methodListView selection.
-	    self updateMethodListWithScroll:false.
+	self updateMethodListWithScroll:false.
-	    methodListView selection:sel.
+	methodListView selection:sel.
-	    self initializeMethodMenu
+	currentClass changed:#methodDictionary with:currentSelector.
-	].
 ]
 !
 methodBreakPoint
 "set a breakpoint on the current method"
 	    methodListView selection:sel
 	].
 ]
 !
-methodTrace
-"turn on tracing of the current method"
-|sel|
-currentMethod notNil ifTrue:[
-	currentMethod isWrapped ifFalse:[
-	    currentMethod := MessageTracer traceMethod:currentMethod.
-	    self initializeMethodMenu2.
-	    sel := methodListView selection.
-	    self updateMethodListWithScroll:false.
-	    methodListView selection:sel
-	].
-]
-!
 methodTraceSender
 "turn on tracing of the current method"
 |sel|
-currentMethod notNil ifTrue:[
+(currentMethod notNil and:[currentMethod isWrapped not])
-	currentMethod isWrapped ifFalse:[
+ifTrue:[
-	    currentMethod := MessageTracer traceMethodSender:currentMethod.
+	currentMethod := MessageTracer traceMethodSender:currentMethod.
-	    self initializeMethodMenu2.
+	sel := methodListView selection.
-	    sel := methodListView selection.
+	self updateMethodListWithScroll:false.
-	    self updateMethodListWithScroll:false.
+	methodListView selection:sel.
-	    methodListView selection:sel
+	currentClass changed:#methodDictionary with:currentSelector.
-	].
+]
-]
+!
+methodMenuForWrappedMethod
+|labels|
+labels := resources array:#(
+					 'fileOut'
+					 'printOut'
+					 '-'
+					 'SPAWN_METHOD'
+					 '-'
+					 'senders ...'
+					 'implementors ...'
+					 'globals ...'
+"
+					 'strings ...'
+					 'apropos ...'
+"
+					 '-'
+					 'local senders ...'
+					 'local implementors ...'
+"
+					 'local strings ...'
+"
+					 '-'
+					 'remove break/trace'
+					 '-'
+					 'new method'
+					 'change category ...'
+					 'remove').
+^ PopUpMenu
+				labels:labels
+			     selectors:#(methodFileOut
+					 methodPrintOut
+					 nil
+					 methodSpawn
+					 nil
+					 methodSenders
+					 methodImplementors
+					 methodGlobalReferends
+"
+					 methodStringSearch
+					 methodAproposSearch
+"
+					 nil
+					 methodLocalSenders
+					 methodLocalImplementors
+"
+					 methodLocalStringSearch
+"
+					 nil
+					 methodRemoveBreakOrTrace
+					 nil
+					 methodNewMethod
+					 methodChangeCategory
+					 methodRemove)
+			      receiver:self
+				   for:methodListView
 ! !
-!SystemBrowser methodsFor:'class-method menu'!
+!SystemBrowser methodsFor:'variable list menu'!
+initializeVariableListMenu
+|varMenu|
+varMenu := (PopUpMenu labels:(resources array:#(
+					'instvar refs ...'
+					'classvar refs ...'
+					'all instvar refs ...'
+					'all classvar refs ...'
+					'-'
+					'instvar mods ...'
+					'classvar mods ...'
+					'all instvar mods ...'
+					'all classvar mods ...'
+				     ))
+			   selectors:#(
+					instVarRefs
+					classVarRefs
+					allInstVarRefs
+					allClassVarRefs
+					nil
+					instVarMods
+					classVarMods
+					allInstVarMods
+					allClassVarMods
+				     )
+			   receiver:self
+				for:self).
+variableListView isNil ifTrue:[
+	classListView notNil ifTrue:[
+	    |menu|
+	    menu := classListView middleButtonMenu.
+	    menu addLabel:(resources string:'variable search')
+		 selector:#variables
+		 before:#classRefs.
+	    menu subMenuAt:#variables put:varMenu.
+	]
+] ifFalse:[
+	variableListView middleButtonMenu:varMenu
+]
+!
+variableSelection:lineNr
+"variable selection changed"
+|name idx|
+name := variableListView selectionValue.
+name isNil ifTrue:[
+	self unhilightMethodCategories.
+	self unhilightMethods.
+	self autoSearch:nil.
+	^ self
+].
+"
+first, check if the selected variable is really the one
+we get - reselect if its hidden (for example, a class variable
+with the same name could be defined in a subclass)
+"
+idx := variableListView list findLast:[:entry | entry = name].
+idx ~~ lineNr ifTrue:[
+	"select it - user will see whats going on"
+	variableListView selection:idx
+].
+"search for methods in the current category, which access the selected
+variable, and highlight them"
+self hilightMethodsInMethodCategoryList:true inMethodList:true.
+self autoSearch:name.
+!
+enterBoxForVariableSearch:title
+|box sel|
+box := self enterBoxForCodeSelectionTitle:title okText:'browse'.
+variableListView notNil ifTrue:[
+	codeView hasSelection ifFalse:[
+	    (sel := variableListView selectionValue) notNil ifTrue:[
+		(sel startsWith:'---') ifFalse:[
+		    box initialText:sel
+		]
+	    ]
+	]
+].
+^ box
+!
+allClassOrInstVarRefsTitle:title access:access mods:modifications
+"show an enterbox for instVar to search for"
+self doClassMenu:[
+	|box|
+	box := self enterBoxForVariableSearch:title.
+	box action:[:aVariableName |
+	    self withCursor:(Cursor questionMark) do:[
+		|homeClass|
+		homeClass := self findClassOfVariable:aVariableName
+					   accessWith:access.
+		(self class) browseInstRefsTo:aVariableName
+					under:homeClass
+			    modificationsOnly:modifications
+	    ]
+	].
+	box showAtPointer
+]
+!
+instVarRefsOrModsTitle:title mods:mods
+"show an enterbox for instvar to search for"
+self doClassMenu:[
+	|box|
+	box := self enterBoxForVariableSearch:title.
+	box action:[:aString |
+	    self withCursor:(Cursor questionMark) do:[
+		self class browseInstRefsTo:aString
+					 in:(Array with:currentClass)
+			  modificationsOnly:mods
+	    ]
+	].
+	box showAtPointer
+]
+!
+allClassVarMods
+"show an enterbox for classVar to search for"
+self allClassOrInstVarRefsTitle:'class variable to browse modifications of:'
+				  access:#classVarNames
+				  mods:true
+!
+instVarMods
+"show an enterbox for instVar to search for"
+self instVarRefsOrModsTitle:'instance variable to browse modifications of:'
+				mods:true
+!
+instVarRefs
+"show an enterbox for instVar to search for"
+self instVarRefsOrModsTitle:'instance variable to browse references to:'
+			   mods:false
+!
+classVarRefsOrModsTitle:title mods:mods
+"show an enterbox for classVar to search for"
+self doClassMenu:[
+	|box|
+	box := self enterBoxForVariableSearch:title.
+	box action:[:aString |
+	    self withCursor:(Cursor questionMark) do:[
+		self class browseClassRefsTo:aString
+					  in:(Array with:currentClass)
+			   modificationsOnly:mods
+	    ]
+	].
+	box showAtPointer
+]
+!
+allInstVarRefs
+"show an enterbox for instVar to search for"
+self allClassOrInstVarRefsTitle:'instance variable to browse references to:'
+				  access:#instVarNames
+				  mods:false
+!
+classVarRefs
+"show an enterbox for classVar to search for"
+self classVarRefsOrModsTitle:'class variable to browse references to:'
+				 mods:false
+!
+classVarMods
+"show an enterbox for classVar to search for"
+self classVarRefsOrModsTitle:'class variable to browse modifications of:'
+				 mods:true
+!
+allInstVarMods
+"show an enterbox for instVar to search for"
+self allClassOrInstVarRefsTitle:'instance variable to browse modifications of:'
+				  access:#instVarNames
+				  mods:true
+!
+allClassVarRefs
+"show an enterbox for classVar to search for"
+self allClassOrInstVarRefsTitle:'class variable to browse references to:'
+				  access:#classVarNames
+				  mods:false
+! !
+!SystemBrowser methodsFor:'class-method list menu'!
 initializeClassMethodMenu
 |labels|
 labels := resources array:#(
 	    ^ self warn:'cannot create: %1' with:fileName
 	].
 	self withWaitCursorDo:[
 	    list := classMethodListView list.
 	    list do:[:line |
-		self label:('System Browser writing: ' , line).
+		self busyLabel:'writing: ' with:line.
 		classString := self classFromClassMethodString:line.
 		selectorString := self selectorFromClassMethodString:line.
 		((classString ~= 'Metaclass') and:[classString endsWith:'class']) ifTrue:[
 			box yesText:'continue' noText:'abort'.
 			(box confirm:('fileOut error: ' , ex errorString ,
 					       '\\continue anyway ?') withCRs) ifTrue:[
 			    ex proceed
 			].
-			self label:'System Browser'.
+			self normalLabel.
 			^ self
 		    ] do:[
 			cls fileOutMethod:mth on:outStream.
 		    ]
 		]
 	    self normalLabel.
 	]
 ]
 ! !
-!SystemBrowser methodsFor:'dependencies'!
+SystemBrowser initialize!
-update
-"handle changes from other browsers"
-|oldClassCategory oldClassName oldMethodCategory oldMethod oldSelector|
-self updateClassCategoryListWithScroll:false.
-"
-self updateClassListWithScroll:false.
-"
-^ self.
-oldClassCategory := currentClassCategory.
-currentClass notNil ifTrue:[
-	oldClassName := currentClass name
-].
-oldMethodCategory := currentMethodCategory.
-oldMethod := currentMethod.
-methodListView notNil ifTrue:[
-	oldMethod notNil ifTrue:[
-	    oldSelector := methodListView selectionValue
-	]
-].
-classCategoryListView notNil ifTrue:[
-	classCategoryListView setContents:(self listOfAllClassCategories).
-	oldClassCategory notNil ifTrue:[
-	    classCategoryListView selectElement:oldClassCategory
-	].
-	classCategoryListView selection isNil ifTrue:[
-	    currentClassCategory := nil.
-	    self switchToClass:nil.
-	    oldClassName := nil
-	]
-].
-classListView notNil ifTrue:[
-	self updateClassListWithScroll:false.
-	oldClassName notNil ifTrue:[
-	      classListView selectElement:oldClassName
-	].
-	classListView selection isNil ifTrue:[
-	    self switchToClass:nil.
-	    currentMethodCategory := nil.
-	    oldMethodCategory := nil
-	]
-].
-methodCategoryListView notNil ifTrue:[
-	self updateMethodCategoryListWithScroll:false.
-	oldMethodCategory notNil ifTrue:[
-	    methodCategoryListView selectElement:oldMethodCategory
-	].
-	methodCategoryListView selection isNil ifTrue:[
-	    currentMethodCategory := nil.
-	    currentMethod := nil.
-	    oldSelector := nil
-	]
-].
-methodListView notNil ifTrue:[
-	self updateMethodListWithScroll:false.
-	oldSelector notNil ifTrue:[
-	    methodListView selectElement:oldSelector
-	].
-	methodListView selection isNil ifTrue:[
-	    currentMethod := nil
-	]
-].
-self updateCodeView
-!
-update:something with:someArgument from:changedObject
-(changedObject == Smalltalk) ifTrue:[self update. ^ self].
-changedObject isBehavior ifTrue:[
-	(currentClass notNil and:[changedObject name = currentClass name]) ifTrue:[
-	    currentClass := Smalltalk at:(currentClass name asSymbol).
-	    showInstance ifTrue:[
-		actualClass := currentClass
-	    ] ifFalse:[
-		actualClass := currentClass class
-	    ].
-	    self updateMethodCategoryListWithScroll:false.
-	    "dont update codeView ...."
-	    "self update"
-	    ^ self
-	]
-]
-! !

changeset 52	7b48409ae088
parent 49	6fe62433cfa3
child 53	2fc78a0165e7