hg/stx-libtool: comparison BrowserView.st

equal deleted inserted replaced

-:87fc74d6ea91
+:9f1583be2b81
 hereby transferred.
 "
 StandardSystemView subclass:#BrowserView
 	 instanceVariableNames:'classCategoryListView classListView methodCategoryListView
-		methodListView classMethodListView codeView classToggle
+methodListView classMethodListView codeView classToggle
-		instanceToggle currentClassCategory currentClassHierarchy
+instanceToggle currentClassCategory currentClassHierarchy
-		currentClass currentMethodCategory currentMethod currentSelector
+currentClass currentMethodCategory currentMethod currentSelector
-		showInstance actualClass fullClass lastMethodCategory aspect
+showInstance actualClass fullClass lastMethodCategory aspect
-		variableListView fullProtocol lockUpdates autoSearch myLabel
+variableListView fullProtocol lockUpdates autoSearch myLabel
-		acceptClass lastSourceLogMessage'
+acceptClass lastSourceLogMessage'
 	 classVariableNames:'CheckForInstancesWhenRemovingClasses RememberAspect DefaultIcon'
 	 poolDictionaries:''
 	 category:'Interface-Browsers'
 !
 !BrowserView methodsFor:'class category list menu'!
 classCategoryCheckinEach
 self withWaitCursorDo:[
-	|logMessage|
+|logMessage|
-	logMessage := Dialog
+logMessage := Dialog
-			 request:'enter a log message (used for all):'
+request:'enter a log message (used for all):'
-			 initialAnswer:''
+initialAnswer:''
-			 onCancel:nil.
+onCancel:nil.
-	logMessage notNil ifTrue:[
+logMessage notNil ifTrue:[
-	    Smalltalk allClassesInCategory:currentClassCategory do:[:aClass |
+Smalltalk allClassesInCategory:currentClassCategory do:[:aClass |
-		self busyLabel:'checking in %1' with:aClass name.
+self busyLabel:'checking in %1' with:aClass name.
-		SourceCodeManager checkinClass:aClass logMessage:logMessage.
+(aClass sourceCodeManager) checkinClass:aClass logMessage:logMessage.
-		self normalLabel.
+self normalLabel.
-	    ]
+]
-	].
+].
-	self normalLabel.
+self normalLabel.
 ]
 "Created: 23.11.1995 / 11:41:38 / cg"
-"Modified: 23.11.1995 / 18:43:34 / cg"
+"Modified: 7.12.1995 / 13:17:04 / cg"
 !
 classCategoryClone
 "open a new SystemBrowser showing the same method as I do"
 |labels selectors m|
 (device ctrlDown
 and:[currentClass notNil]) ifTrue:[
-	labels :=  #(
+labels :=  #(
-		       'inspect class'
+'inspect class'
-		       '-'
+'-'
-		       'primitive definitions'
+'primitive definitions'
-		       'primitive variables'
+'primitive variables'
-		       'primitive functions'
+'primitive functions'
-		    ).
+).
-	selectors := #(
+selectors := #(
-		       classInspect
+classInspect
-		       nil
+nil
-		       classPrimitiveDefinitions
+classPrimitiveDefinitions
-		       classPrimitiveVariables
+classPrimitiveVariables
-		       classPrimitiveFunctions
+classPrimitiveFunctions
-		     ).
+).
-	labels := labels , #(
+labels := labels , #(
-			     '-'
+'-'
-			     'revision info'
+'revision info'
-			     'compare with repository'
+'compare with repository'
-			     '-'
+'-'
-			     'check into source repository'
+'check into source repository'
-			     'fileIn from repository'
+'fileIn from repository'
-			   ).
+).
-	selectors := selectors , #(
+selectors := selectors , #(
-			     nil
+nil
-			     classRevisionInfo
+classRevisionInfo
-			     classCompareWithNewestInRepository
+classCompareWithNewestInRepository
-			     nil
+nil
-			     classCheckin
+classCheckin
-			     classLoadRevision
+classLoadRevision
-			    ).
+).
 ] ifFalse:[
-	currentClass isNil ifTrue:[
+currentClass isNil ifTrue:[
-	    labels :=    #(
+labels :=    #(
-			   'new class'
+'new class'
-			 ).
+).
-	    selectors := #(
+selectors := #(
-			   classNewClass
+classNewClass
-			 ).
+).
-	] ifFalse:[
+] ifFalse:[
-	    currentClass isLoaded ifFalse:[
+currentClass isLoaded ifFalse:[
-		labels :=    #(
+labels :=    #(
-			       'new class'
+'new class'
-			       '-'
+'-'
-			       'load '
+'load '
-			     ).
+).
-		selectors := #(
+selectors := #(
-			       classNewClass
+classNewClass
-			       nil
+nil
-			       classLoad
+classLoad
-			     ).
+).
-	    ] ifTrue:[
+] ifTrue:[
-		fullProtocol ifTrue:[
+fullProtocol ifTrue:[
-		    labels :=    #(
+labels :=    #(
-				   'hierarchy'
+'hierarchy'
-				   'definition'
+'definition'
-				   'comment'
+'comment'
-				   'class instvars'
+'class instvars'
-				 ).
+).
-		    selectors := #(
+selectors := #(
-				   classHierarchy
+classHierarchy
-				   classDefinition
+classDefinition
-				   classComment
+classComment
-				   classClassInstVars
+classClassInstVars
-				  ).
+).
-		] ifFalse:[
+] ifFalse:[
-		    labels :=    #(
+labels :=    #(
-				   'fileOut'
+'fileOut'
-				   'printOut'
+'printOut'
-				   'printOut protocol'
+'printOut protocol'
-				 " 'printOut full protocol' "
+" 'printOut full protocol' "
-				   '-'
+'-'
-				   'SPAWN_CLASS'
+'SPAWN_CLASS'
-				   'spawn full protocol'
+'spawn full protocol'
-				   'spawn hierarchy'
+'spawn hierarchy'
-				   'spawn subclasses'
+'spawn subclasses'
-				   '-'
+'-'
-				  ).
+).
-		    selectors := #(
+selectors := #(
-				   classFileOut
+classFileOut
-				   classPrintOut
+classPrintOut
-				   classPrintOutProtocol
+classPrintOutProtocol
-				"  classPrintOutFullProtocol "
+"  classPrintOutFullProtocol "
-				   nil
+nil
-				   classSpawn
+classSpawn
-				   classSpawnFullProtocol
+classSpawnFullProtocol
-				   classSpawnHierarchy
+classSpawnHierarchy
-				   classSpawnSubclasses
+classSpawnSubclasses
-				   nil
+nil
-				  ).
+).
-		    fullClass ifFalse:[
+fullClass ifFalse:[
-			labels := labels , #(
+labels := labels , #(
-				   'hierarchy'
+'hierarchy'
-				   'definition'
+'definition'
-				   'comment'
+'comment'
-				   'class instvars'
+'class instvars'
-		   "/              'protocols'
+"/              'protocols'
-				   '-'
+'-'
-				  ).
+).
-			selectors := selectors , #(
+selectors := selectors , #(
-				   classHierarchy
+classHierarchy
-				   classDefinition
+classDefinition
-				   classComment
+classComment
-				   classClassInstVars
+classClassInstVars
-		   "/              classProtocols
+"/              classProtocols
-				   nil
+nil
-				  ).
+).
-		    ].
+].
-		    labels := labels , #(
+labels := labels , #(
-		   "/              'variable search'
+"/              'variable search'
-				   'class refs'
+'class refs'
-				   '-'
+'-'
-				   'new class'
+'new class'
-				   'new subclass'
+'new subclass'
-				   'rename ...'
+'rename ...'
-				   'remove'
+'remove'
-				  ).
+).
-		    selectors := selectors , #(
+selectors := selectors , #(
-		   "/              variables
+"/              variables
-				   classRefs
+classRefs
-				   nil
+nil
-				   classNewClass
+classNewClass
-				   classNewSubclass
+classNewSubclass
-				   classRename
+classRename
-				   classRemove
+classRemove
-				  ).
+).
-		    currentClass wasAutoloaded ifTrue:[
+currentClass wasAutoloaded ifTrue:[
-			labels := labels , #(
+labels := labels , #(
-				   'unload'
+'unload'
-				  ).
+).
-			selectors := selectors , #(
+selectors := selectors , #(
-				   classUnload
+classUnload
-				  ).
+).
-		    ]
+]
-		]
+]
-	    ].
+].
-	].
+].
 ].
 m := PopUpMenu
-	    labels:(resources array:labels)
+labels:(resources array:labels)
-	    selectors:selectors.
+selectors:selectors.
-SourceCodeManager isNil ifTrue:[
+(currentClass isNil
-	m disableAll:#(classRevisionInfo classLoadRevision classCheckin classCompareWithNewestInRepository).
+or:[currentClass sourceCodeManager isNil]) ifTrue:[
+m disableAll:#(classRevisionInfo classLoadRevision classCheckin classCompareWithNewestInRepository).
 ].
 ^ m
-"Modified: 25.11.1995 / 10:45:16 / cg"
+"Modified: 7.12.1995 / 13:19:57 / cg"
 !
 classNewClass
 "create a class-definition prototype in codeview"
 * includes, defines, structure definitions
 * and typedefs come here.
 */
 %}'
-!
+!!
 classPrimitiveFunctions
 "show the classes primitiveFunctions in the codeView.
 Also, set accept action to change it."
 * any local C (helper) functions
 * come here (please, define as static)
 */
 %}'
-!
+!!
 classPrimitiveVariables
 "show the classes primitiveVariables in the codeView.
 Also, set accept action to change it."
 * any local C variables
 * come here (please, define as static)
 */
 %}'
-!
+!!
 classPrintOut
 self classPrintOutWith:#printOutOn:
-!
+!!
 classPrintOutFullProtocol
 self classPrintOutWith:#printOutFullProtocolOn:
-!
+!!
 classPrintOutProtocol
 self classPrintOutWith:#printOutProtocolOn:
-!
+!!
 classPrintOutWith:aSelector
 self doClassMenu:[:currentClass |
 	|printStream|
 	printStream := Printer new.
 	currentClass perform:aSelector with:printStream.
 	printStream close
 ]
-!
+!!
 classProtocols
 ^ self
-!
+!!
 classRefs
 self doClassMenu:[:currentClass |
 	self withSearchCursorDo:[
 	    SystemBrowser browseReferendsOf:currentClass name asSymbol
 	]
 ]
 "Created: 23.11.1995 / 14:11:43 / cg"
-!
+!!
 classRemove
 "user requested remove of current class and all subclasses -
 count subclasses and let user confirm removal."
 		    codeView modified: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
-!
+!!
 classShowFrom:getSelector set:setSelector aspect:aspectSymbol default:default
 "common helper for comment, primitive-stuff etc.
 show the string returned from the classes getSelector-method,
 Set acceptaction to change it via setSelector."
 	    methodListView deselect
 	].
 	aspect := aspectSymbol.
 	self normalLabel
 ]
-!
+!!
 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."
 "
 select 'Smalltalk allClassesDo:' and use spawn from the class menu
 select 'Smalltalk'               and use spawn from the class menu
 "
-!
+!!
 classSpawnFullProtocol
 "create a new browser, browsing current classes full protocol"
 self doClassMenuWithSelection:[:cls :sel |
 	SystemBrowser browseFullClassProtocol:cls
 ]
-!
+!!
 classSpawnHierarchy
 "create a new HierarchyBrowser browsing current class"
 self doClassMenuWithSelection:[:cls :sel |
 	SystemBrowser browseClassHierarchy:cls
 ]
-!
+!!
 classSpawnSubclasses
 "create a new browser browsing current class's subclasses"
 self doClassMenuWithSelection:[:cls :sel |
 	subs := cls allSubclasses.
 	(subs notNil and:[subs size ~~ 0]) ifTrue:[
 	    SystemBrowser browseClasses:subs title:('subclasses of ' , cls name)
 	]
 ]
-!
+!!
 classUnload
 "unload an autoloaded class"
 |nm|
 self checkClassSelected ifFalse:[^ self].
 nm := currentClass name.
 currentClass unload.
 self switchToClassNamed:nm
-!
+!!
 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"
 	    SystemBrowser browseUsesOf:currentClass
 	]
 ]
 "Created: 23.11.1995 / 14:11:47 / cg"
-!
+!!
 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
 	sel notNil ifTrue:[
 	    sel := self selectorFromClassMethodString:sel
 	]
 ].
 self doClassMenu:[:currentClass | aBlock value:currentClass value:sel]
-! !
+!! !!
-!BrowserView methodsFor:'class list source administration'!
+!!BrowserView methodsFor:'class list source administration'!!
 classCreateSourceContainerFor:aClass
 "let user specify the source-repository values for aClass"
 |box
 box accepted ifTrue:[
 	self halt.
 ]
 "Modified: 25.11.1995 / 18:03:25 / cg"
-!
+!!
 classCheckin
 "check a class into the source repository"
 self doClassMenu:[:currentClass |
 	]
 ]
 "Created: 23.11.1995 / 11:41:38 / cg"
 "Modified: 3.12.1995 / 13:28:30 / cg"
-!
+!!
 classCompareWithNewestInRepository
 "open a diff-textView comparing the current (in-image) version
 with the most recent version found in the repository."
 	]
 ]
 "Created: 14.11.1995 / 16:43:15 / cg"
 "Modified: 22.11.1995 / 22:17:08 / cg"
-!
+!!
 classRevisionInfo
 "show current classes revision info in codeView"
 self doClassMenu:[:currentClass |
 	self normalLabel
 ]
 "Created: 14.11.1995 / 16:43:15 / cg"
 "Modified: 7.12.1995 / 11:00:56 / cg"
-!
+!!
 classLoadRevision
 "load a specific revision into the system - especially useful to
 upgrade a class to the newest revision"
 	]
 ]
 "Created: 14.11.1995 / 16:43:15 / cg"
 "Modified: 25.11.1995 / 10:44:38 / cg"
-! !
+!! !!
-!BrowserView methodsFor:'class stuff'!
+!!BrowserView methodsFor:'class stuff'!!
 checkClassSelected
 "warn and return false, if no class is selected"
 currentClass isNil ifTrue:[
 	self warn:'select a class first'.
 	^ false
 ].
 ^ true
-!
+!!
 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."
 	].
 	codeView cursor:(Cursor normal).
 ].
 codeView explainAction:nil.
 self switchToClass:nil
-!
+!!
 classListUpdate
 RememberAspect ifTrue:[
 	aspect == #hierarchy ifTrue:[
 	    ^ self classHierarchy
 ].
 self classDefinition
 "Created: 23.11.1995 / 11:28:58 / cg"
 "Modified: 23.11.1995 / 11:36:08 / cg"
-!
+!!
 classSelection:lineNr
 "user clicked on a class line - show method categories"
 |cls oldSelector|
 cls := Smalltalk classNamed:classListView selectionValue withoutSpaces.
 cls notNil ifTrue:[
 	self switchToClass:cls.
 	self classSelectionChanged
 ]
-!
+!!
 classSelectionChanged
 |oldMethodCategory oldMethod oldSelector|
 self withWaitCursorDo:[
 	self setDoitActionForClass
 ]
 "Created: 23.11.1995 / 11:32:03 / cg"
-!
+!!
 doClassMenu:aBlock
 "a helper - check if class is selected and evaluate aBlock
 while showing waitCursor"
 self checkClassSelected ifTrue:[
 	self withWaitCursorDo:[aBlock value:currentClass]
 ]
-!
+!!
 listOfAllClassesInCategory:aCategory
 "return a list of all classes in a given category"
 |newList classes searchCategory nm|
 	    ]
 	]
 ].
 (newList size == 0) ifTrue:[^ nil].
 ^ newList asOrderedCollection sort
-!
+!!
 listOfClassHierarchyOf:aClass
 "return a hierarchy class-list"
 |startClass classes thisOne|
 fullProtocol ifFalse:[
 	classes := classes , startClass allSubclassesInOrder
 ].
 ^ classes collect:[:c | c name]
-!
+!!
 renameCurrentClassTo:aString
 "helper - do the rename"
 self doClassMenu:[:currentClass |
 	    SystemBrowser browseReferendsOf:oldSym warnIfNone:false
 	]
 ]
 "Created: 25.11.1995 / 13:02:53 / cg"
-!
+!!
 switchToClass:newClass
 "switch to some other class;
 keep instance protocol as it was ..."
 	currentClass addDependent:self.
 ].
 self normalLabel.
 "Modified: 1.9.1995 / 01:04:05 / claus"
-!
+!!
 switchToClassNameMatching:aMatchString
 |classNames thisName box|
 classNames := OrderedCollection new.
 box := self listBoxTitle:'select class to switch to:'
 		      okText:'ok'
 			list:classNames sort.
 box action:[:aString | self switchToClassNamed:aString].
 box showAtPointer
-!
+!!
 switchToClassNamed:aString
 |meta str classSymbol theClass newCat element|
 meta := false.
 	self instanceProtocol:meta not.
 	self classSelectionChanged
 ]
 "Modified: 1.9.1995 / 01:41:35 / claus"
-!
+!!
 templateFor:className in:cat
 "return a class definition template - be smart in what is offered initially"
 |aString name i|
 add some documentation; either under the classes documentation
 protocol, or as a class comment.
 "
 '.
 ^ aString
-!
+!!
 updateClassList
 self updateClassListWithScroll:true
-!
+!!
 updateClassListWithScroll:scroll
 |classes oldClassName|
 classListView notNil ifTrue:[
 	    fullProtocol ifTrue:[
 		classListView scrollToBottom
 	    ]
 	]
 ]
-! !
+!! !!
-!BrowserView methodsFor:'class-method list menu'!
+!!BrowserView methodsFor:'class-method list menu'!!
 classMethodFileOutAll
 "fileout all methods into one source file"
 |list classString selectorString cls mth outStream fileName append
 	    ].
 	    outStream close.
 	    self normalLabel.
 	]
 ]
-!
+!!
 classMethodMenu
 |labels selectors|
 labels := #(
 				methodRemove
 		  ).
 ^ PopUpMenu labels:(resources array:labels)
 		selectors:selectors
-! !
+!! !!
-!BrowserView methodsFor:'class-method stuff'!
+!!BrowserView methodsFor:'class-method stuff'!!
 classFromClassMethodString:aString
 "helper for classMethod-list - extract class name from the string"
 "/    |pos|
 "/
 "/    pos := aString indexOf:(Character space).
 "/    ^ aString copyTo:(pos - 1)
 ^ aString upTo:Character space
-!
+!!
 classMethodSelection:lineNr
 "user clicked on a class/method line - show code"
 |cls string classString selectorString meta|
 ].
 self setDoitActionForClass
 "Modified: 31.8.1995 / 11:56:02 / claus"
-!
+!!
 selectorFromClassMethodString:aString
 "helper for classMethod-list - extract selector from the string"
 |pos|
 pos := aString indexOf:(Character space).
 ^ aString copyFrom:(pos + 1)
-! !
+!! !!
-!BrowserView methodsFor:'help'!
+!!BrowserView methodsFor:'help'!!
 helpTextFor:aComponent
 |s|
 aComponent == classCategoryListView ifTrue:[
 	^ resources string:s
 ].
 ^ nil
 "Modified: 31.8.1995 / 19:11:39 / claus"
-! !
+!! !!
-!BrowserView methodsFor:'initialize / release'!
+!!BrowserView methodsFor:'initialize / release'!!
 autoSearch:aString
 "used with class-method list browsing. If true,
 selecting an entry from the list will automatically
 search for the searchstring in the codeView"
 self setSearchPattern:aString.
 autoSearch := aString
-!
+!!
 destroy
 "relese dependant - destroy popups"
 Smalltalk removeDependent:self.
 currentClass notNil ifTrue:[
 	currentClass removeDependent:self.
 	currentClass := nil
 ].
 super destroy
-!
+!!
 initialize
 super initialize.
 showInstance := true.
 fullProtocol := false.
 aspect := nil.
 "inform me, when Smalltalk changes"
 Smalltalk addDependent:self
-!
+!!
 realize
 |v checkBlock|
 super realize.
 initially
 "
 currentClassHierarchy notNil ifTrue:[
 	classListView scrollToBottom.
 ]
-!
+!!
 terminate
 (self checkSelectionChangeAllowed) ifTrue:[
 	super terminate
 ]
-!
+!!
 title:someString
 myLabel := someString.
 self label:someString.
-! !
+!! !!
-!BrowserView methodsFor:'initialize subviews'!
+!!BrowserView methodsFor:'initialize subviews'!!
 createClassListViewIn:frame
 "setup the classlist subview, with its toggles"
 |v panel|
 v := ScrollableView for:SelectionInListView in:panel.
 v origin:(0.0 @ 0.7) corner:(1.0 @ 1.0).
 variableListView := v scrolledView.
-!
+!!
 createCodeViewIn:aView
 "setup the code view"
 ^ self createCodeViewIn:aView at:0.25
-!
+!!
 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"
 |h halfSpace classAction instanceAction|
 	instanceToggle leftInset:halfSpace.
 	classToggle leftInset:halfSpace.
 	instanceToggle rightInset:ViewSpacing - halfSpace.
 	classToggle rightInset:ViewSpacing - halfSpace.
 ].
-!
+!!
 focusSequence
 |s|
 s := OrderedCollection new.
 	s add:classMethodListView
 ].
 s add:codeView.
 ^ s
-!
+!!
 setupForAll
 "create subviews for a full browser"
 |vpanel hpanel frame v|
 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 createCodeViewIn:vpanel
-!
+!!
 setupForClass:aClass
 "create subviews for browsing a single class"
 |vpanel hpanel frame v|
 actualClass := acceptClass := aClass.
 self updateMethodCategoryList.
 self updateMethodList.
 self updateCodeView.
 self classDefinition.
-!
+!!
 setupForClass:aClass methodCategory:aMethodCategory
 "setup subviews to browse a method category"
 |vpanel v|
 self switchToClass:aClass.
 actualClass := acceptClass := aClass.
 currentMethodCategory := aMethodCategory.
 self updateMethodList.
 self updateCodeView.
-!
+!!
 setupForClass:aClass selector:selector
 "setup subviews to browse a single method"
 |v|
 actualClass := acceptClass := aClass.
 currentSelector := selector.
 currentMethod := currentClass compiledMethodAt:selector.
 currentMethodCategory := currentMethod category.
 self updateCodeView
-!
+!!
 setupForClassCategory:aClassCategory
 "setup subviews to browse a class category"
 |vpanel hpanel frame v|
 currentClassCategory := aClassCategory.
 self updateClassList.
 self updateMethodCategoryList.
 self updateMethodList.
 self updateCodeView
-!
+!!
 setupForClassHierarchy:aClass
 "setup subviews to browse a class hierarchy"
 |vpanel hpanel frame v cls|
 self updateCodeView.
 aClass isMeta ifTrue:[
 	self instanceProtocol:false
 ].
-!
+!!
 setupForClassList:aList
 "setup subviews to browse classes from a list"
 |vpanel hpanel frame l v|
 classListView list:(l sort).
 self updateMethodCategoryList.
 self updateMethodList.
 self updateCodeView
-!
+!!
 setupForFullClass
 "setup subviews to browse a class as full text"
 |vpanel hpanel v|
 self createCodeViewIn:vpanel.
 fullClass := true.
 self updateCodeView
-!
+!!
 setupForFullClassProtocol:aClass
 "setup subviews to browse a classes full protocol"
 |vpanel hpanel frame v cls|
 self updateCodeView.
 self updateVariableList.
 aClass isMeta ifTrue:[
 	self instanceProtocol:false
 ].
-!
+!!
 setupForList:aList
 "setup subviews to browse methods from a list"
 |vpanel v|
 aList size == 1 ifTrue:[
 	classMethodListView selection:1.
 	self classMethodSelection:1.
 ].
 self updateCodeView
-! !
+!! !!
-!BrowserView methodsFor:'method category list menu'!
+!!BrowserView methodsFor:'method category list menu'!!
 methodCategoryCopyCategory
 "show the enter box to copy from an existing method category"
 |title box|
 		      okText:'ok'
 			list:(Smalltalk allClasses collect:[:cls | cls name]) asArray sort.
 box action:[:aString | self copyMethodsFromClass:aString].
 box showAtPointer
-!
+!!
 methodCategoryCreateAccessMethods
 "create access methods for all instvars"
 self checkClassSelected ifFalse:[^ self].
 	    ].
 	].
 	self updateMethodCategoryListWithScroll:false.
 	self updateMethodListWithScroll:false
 ]
-!
+!!
 methodCategoryCreateDocumentationMethods
 "create empty documentation methods"
 |cls histStream|
 	self instanceProtocol:false.
 	self switchToMethodNamed:#documentation
 "/        self updateMethodCategoryListWithScroll:false.
 "/        self updateMethodListWithScroll:false
 ]
-!
+!!
 methodCategoryFileOut
 "fileOut all methods in the selected methodcategory of
 the current class"
 	] do:[
 	    actualClass fileOutCategory:currentMethodCategory.
 	].
 	self normalLabel.
 ]
-!
+!!
 methodCategoryFileOutAll
 "fileOut all methods in the selected methodcategory of
 the current class"
 	    ].
 	].
 	outStream close.
 	self normalLabel.
 ].
-!
+!!
 methodCategoryFindAnyMethod
 |box|
 box := self enterBoxForSearchSelectorTitle:'method selector to search for:'.
 box action:[:aString | self switchToAnyMethodNamed:aString].
 box showAtPointer
-!
+!!
 methodCategoryFindMethod
 |box|
 box := self enterBoxForSearchSelectorTitle:'method selector to search for:'.
 box action:[:aString | self switchToMethodNamed:aString].
 box showAtPointer
-!
+!!
 methodCategoryMenu
 |labels selectors i|
 currentClass isNil ifTrue:[
 	selectors at:i put:#methodCategoryCreateDocumentationMethods
 ].
 ^ PopUpMenu labels:(resources array:labels)
 		 selectors:selectors
-!
+!!
 methodCategoryNewCategory
 "show the enter box to add a new method category.
 Offer existing superclass categories in box to help avoiding
 useless typing."
 box action:[:aString | self newMethodCategory:aString].
 box showAtPointer
-!
+!!
 methodCategoryPrintOut
 |printStream|
 self checkClassSelected ifFalse:[^ self].
 self whenMethodCategorySelected:[
 	printStream := Printer new.
 	actualClass printOutCategory:currentMethodCategory on:printStream.
 	printStream close
 ]
-!
+!!
 methodCategoryRemove
 "show number of methods to remove and query user"
 |count t box|
 		self updateMethodCategoryList.
 		self updateMethodList
 	    ]
 	]
 ]
-!
+!!
 methodCategoryRename
 "launch an enterBox to rename current method category"
 |box|
 	currentMethod := currentSelector := nil.
 	self updateMethodCategoryList.
 	self updateMethodListWithScroll:false
 ].
 box showAtPointer
-!
+!!
 methodCategorySpawn
 "create a new SystemBrowser browsing current method category"
 currentMethodCategory notNil ifTrue:[
 	self withWaitCursorDo:[
 	    SystemBrowser 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 |
 					SystemBrowser browseMethodCategory:aString
 				    ]
-! !
+!! !!
-!BrowserView methodsFor:'method category stuff'!
+!!BrowserView methodsFor:'method category stuff'!!
 checkMethodCategorySelected
 currentMethodCategory isNil ifTrue:[
 	self warn:'select a method category first'.
 	^ false
 ].
 ^ true
-!
+!!
 copyMethodsFromClass:aClassName
 |class box|
 currentClass notNil ifTrue:[
 	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
 currentClass notNil ifTrue:[
 	Object abortSignal catch:[
 	    class methodArray do:[:aMethod |
 		    self updateMethodListWithScroll:false.
 		]
 	    ]
 	]
 ]
-!
+!!
 listOfAllMethodCategoriesInClass:aClass
 "answer a list of all method categories of the argument, aClass"
 |newList|
 	newList add:cat
 ].
 (newList size == 0) ifTrue:[^ nil].
 newList add:'* all *'.
 ^ newList asOrderedCollection sort
-!
+!!
 listOfAllMethodCategoriesInFullProtocolHierarchy:aClass
 "answer a list of all method categories of the argument, aClass,
 and all of its superclasses.
 Used with fullProtocol browsing."
 	]
 ].
 (newList size == 0) ifTrue:[^ nil].
 newList add:'* all *'.
 ^ newList asOrderedCollection sort
-!
+!!
 methodCategorySelection:lineNr
 "user clicked on a method category line - show selectors"
 "/    |oldSelector|
 "/          ]
 "/      ]
 ]
 "Created: 23.11.1995 / 14:19:56 / cg"
-!
+!!
 methodCategorySelectionChanged
 "method category selection has changed - update dependent views"
 self withWaitCursorDo:[
 	self hilightMethodsInMethodCategoryList:false inMethodList:true.
 ]
 "Created: 23.11.1995 / 14:17:38 / cg"
 "Modified: 23.11.1995 / 14:19:49 / cg"
-!
+!!
 newMethodCategory:aString
 |categories|
 currentClass isNil ifTrue:[
 	categories sort.
 	methodCategoryListView contents:categories
 ].
 currentMethodCategory := aString.
 self methodCategorySelectionChanged
-!
+!!
 updateMethodCategoryList
 self updateMethodCategoryListWithScroll:true
-!
+!!
 updateMethodCategoryListWithScroll:scroll
 |categories|
 methodCategoryListView notNil ifTrue:[
 	    currentMethodCategory notNil ifTrue:[
 		methodCategoryListView selectElement:currentMethodCategory
 	    ]
 	]
 ]
-!
+!!
 whenMethodCategorySelected:aBlock
 self checkMethodCategorySelected ifTrue:[
 	self withWaitCursorDo:aBlock
 ]
-! !
+!! !!
-!BrowserView methodsFor:'method list menu'!
+!!BrowserView methodsFor:'method list menu'!!
 commonTraceHelperWith:aSelector
 currentMethod := MessageTracer perform:aSelector with:currentMethod.
 self updateMethodListWithScroll:false keepSelection:true.
 currentClass changed:#methodDictionary with:currentSelector.
-!
+!!
 methodAproposSearch
 "launch an enterBox for a keyword search"
 self askForSelectorTitle:'keyword to search for:'
 		    openWith:#aproposSearch:
-!
+!!
 methodBreakPoint
 "set a breakpoint on the current method"
 currentSelector notNil ifTrue:[
 	    (currentMethod notNil and:[currentMethod isWrapped not]) ifTrue:[
 		self commonTraceHelperWith:#trapMethod:
 	    ]
 	].
 ]
-!
+!!
 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."
 		    self updateMethodListWithScroll:false
 	       ].
 box showAtPointer
 "Created: 29.10.1995 / 19:59:22 / cg"
-!
+!!
 methodDecompile
 "decompile the current methods bytecodes.
 The Decompiler is delivered as an extra, and not normally
 avaliable with the system."
 Decompiler isLoaded ifFalse:[
 	^ self warn:'No decompiler available'.
 ].
 Decompiler decompile:currentMethod.
-!
+!!
 methodFileOut
 "file out the current method"
 self checkMethodSelected ifFalse:[^ self].
 	ex return
 ] do:[
 	actualClass fileOutMethod:currentMethod.
 ].
 self normalLabel.
-!
+!!
 methodGlobalReferends
 "launch an enterBox for global symbol to search for"
 self enterBoxForBrowseTitle:'global variable to browse users of:'
 			 action:[:aString |
 				    SystemBrowser browseReferendsOf:aString asSymbol
 				]
-!
+!!
 methodImplementors
 "launch an enterBox for selector to search for"
 self askForSelectorTitle:'selector to browse implementors of:'
 		    openWith:#browseImplementorsOf:
-!
+!!
 methodInspect
 "inspect  the current method"
 self checkMethodSelected ifFalse:[^ self].
 (actualClass compiledMethodAt:currentSelector) inspect.
-!
+!!
 methodLocalAproposSearch
 "launch an enterBox for a local keyword search"
 self askForSelectorTitle:'keyword to search for:'
 		    openWith:#aproposSearch:in:
 			 and:(currentClass withAllSubclasses)
-!
+!!
 methodLocalImplementors
 "launch an enterBox for selector to search for"
 self checkClassSelected ifFalse:[^ self].
 self askForSelectorTitle:'selector to browse local implementors of:'
 		    openWith:#browseImplementorsOf:under:
 			 and:currentClass
-!
+!!
 methodLocalSenders
 "launch an enterBox for selector to search for in current class & subclasses"
 self checkClassSelected ifFalse:[^ self].
 self askForSelectorTitle:'selector to browse local senders of:'
 		    openWith:#browseCallsOn:under:
 			 and:currentClass
-!
+!!
 methodLocalStringSearch
 "launch an enterBox for string to search for"
 self checkClassSelected ifFalse:[^ self].
 self askForSelectorTitle:'string to search for in local methods:'
 		    openWith:#browseForString:in:
 			 and:(currentClass withAllSubclasses)
-!
+!!
 methodLocalSuperSends
 "launch a browser showing super sends in current class & subclasses"
 self checkClassSelected ifFalse:[^ self].
 	SystemBrowser browseSuperCallsUnder:currentClass
 ]
 "Created: 23.11.1995 / 12:03:57 / cg"
 "Modified: 23.11.1995 / 14:12:15 / cg"
-!
+!!
 methodMakePrivate
 "make the current method private.
 EXPERIMENTAL"
 self methodPrivacy:#private
-!
+!!
 methodMakeProtected
 "make the current method protected.
 EXPERIMENTAL"
 self methodPrivacy:#protected
-!
+!!
 methodMakePublic
 "make the current method public.
 EXPERIMENTAL"
 self methodPrivacy:#public
-!
+!!
 methodMenu
 "return a popupmenu as appropriate for the methodList"
 |m labels selectors
 	].
 ].
 ^ m
 "Created: 23.11.1995 / 12:02:29 / cg"
-!
+!!
 methodNewMethod
 "prepare for definition of a new method - put a template into
 code view and define accept-action to compile it"
 methodListView deselect.
 codeView contents:(self template).
 codeView modified:false.
 self setAcceptAndExplainActionsForMethod.
-!
+!!
 methodPrintOut
 "print out the current method"
 |printStream|
 self checkMethodSelected ifFalse:[^ self].
 printStream := Printer new.
 actualClass printOutSource:(currentMethod source) on:printStream.
 printStream close
-!
+!!
 methodPrivacy:how
 "change the current methods privacy.
 EXPERIMENTAL"
 	actualClass addChangeRecordForMethodPrivacy:currentMethod.
 	self updateMethodListWithScroll:false keepSelection:true.
 ]
 "Created: 29.10.1995 / 20:00:00 / cg"
-!
+!!
 methodRemove
 "remove the current method"
 self checkMethodSelected ifFalse:[^ self].
 actualClass removeSelector:(actualClass selectorAtMethod:currentMethod).
 currentMethod := currentSelector := nil.
 self updateMethodListWithScroll:false
-!
+!!
 methodRemoveBreakOrTrace
 "turn off tracing of the current method"
 (currentMethod notNil and:[currentMethod isWrapped]) ifTrue:[
 	self commonTraceHelperWith:#unwrapMethod:
 ]
-!
+!!
 methodSTCCompile
 "compile the current method to machine code.
 This is not supported on all machines, and never supported in
 the demo version."
 [
 	codeView accept.
 ] valueNowOrOnUnwindDo:[
 	Compiler stcCompilation:prev
 ].
-!
+!!
 methodSenders
 "launch an enterBox for selector to search for"
 self askForSelectorTitle:'selector to browse senders of:'
 		    openWith:#browseAllCallsOn:
-!
+!!
 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."
 self withWaitCursorDo:[
 	w := currentMethod who.
 	SystemBrowser browseClass:(w at:1) selector:(w at:2)
 ]
-!
+!!
 methodStringSearch
 "launch an enterBox for string to search for"
 self askForSelectorTitle:'string to search for in sources:'
 		    openWith:#browseForString:
-!
+!!
 methodTrace
 "turn on tracing of the current method"
 currentClass notNil ifTrue:[
 ].
 (currentMethod notNil and:[currentMethod isWrapped not]) ifTrue:[
 	self commonTraceHelperWith:#traceMethod:
 ]
-!
+!!
 methodTraceSender
 "turn on tracing of the current method"
 (currentMethod notNil and:[currentMethod isWrapped not]) ifTrue:[
 	self commonTraceHelperWith:#traceMethodSender:
 ]
-! !
+!! !!
-!BrowserView methodsFor:'method stuff'!
+!!BrowserView methodsFor:'method stuff'!!
 checkMethodSelected
 currentMethod isNil ifTrue:[
 	self warn:'select a method first'.
 	^ false
 ].
 ^ true
-!
+!!
 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 size == 0) ifTrue:[^ nil].
 ^ newList asOrderedCollection sort
-!
+!!
 listOfAllSelectorsInCategory:aCategory ofClass:aClass
 "answer a list of all selectors in a given method category
 of the argument, aClass"
 	    sel := selector.
 	    (p := aMethod privacy) ~~ #public ifTrue:[
 		how := '    (* ' , p , ' *)'.
 	    ].
 	    aMethod isWrapped ifTrue:[
-		how := ' !!'
+		how := ' !!!!'
 	    ].
 	    aMethod isInvalid ifTrue:[
 		how := '    (** not executable **)'
 	    ].
 	    aMethod isLazyMethod ifTrue:[
 ].
 (newList size == 0) ifTrue:[^ nil].
 ^ newList sort
 "Modified: 28.8.1995 / 21:53:34 / claus"
-!
+!!
 methodSelection:lineNr
 "user clicked on a method line - show code"
 |selectorString selectorSymbol|
 	    ]
 	]
 ].
 self methodSelectionChanged
-!
+!!
 methodSelectionChanged
 "method selection has changed - update dependent views"
 self withWaitCursorDo:[
 	    ]
 	].
 ]
 "Created: 23.11.1995 / 14:17:44 / cg"
-!
+!!
 switchToAnyMethodNamed:aString
 |aSelector classToStartSearch aClass nm|
 aSelector := aString asSymbol.
 	    ].
 	    self switchToClassNamed:nm.
 	    self switchToMethodNamed:aString
 	]
 ]
-!
+!!
 switchToMethodNamed:matchString
 "switch (in the current class) to a method named matchString.
 If there are more than one matches, switch to the first."
 		methodListView selectElement:aSelector.
 	    ].
 	    self methodSelectionChanged
 	]
 ]
-!
+!!
 template
 "return a method definition template"
 ^
 You do not need this template; you can also
 select any existing methods code, change it,
 and finally ''accept''.
 "
 '
-!
+!!
 updateMethodList
 self updateMethodListWithScroll:true keepSelection:false
-!
+!!
 updateMethodListWithScroll:scroll
 self updateMethodListWithScroll:scroll keepSelection:false
-!
+!!
 updateMethodListWithScroll:scroll keepSelection:keep
 |selectors scr first last selection|
 	].
 	keep ifTrue:[
 	    methodListView selection:selection.
 	]
 ]
-! !
+!! !!
-!BrowserView methodsFor:'misc'!
+!!BrowserView methodsFor:'misc'!!
 instanceProtocol:aBoolean
 "switch between instance and class protocol"
 |onToggle offToggle|
 	    ].
 	    onToggle turnOn.
 	    offToggle turnOff.
 	]
 ]
-!
+!!
 processName
 "the name of my process - for the processMonitor only"
 ^ 'System Browser'.
-!
+!!
 updateCodeView
 |code|
 fullClass ifTrue:[
 self normalLabel.
 "Created: 23.11.1995 / 14:16:43 / cg"
 "Modified: 23.11.1995 / 14:19:25 / cg"
-! !
+!! !!
-!BrowserView methodsFor:'private'!
+!!BrowserView methodsFor:'private'!!
 askAndBrowseMethodCategory:title action:aBlock
 "convenient method: setup enterBox with initial being current method category"
 |sel box|
 sel notNil ifTrue:[
 	box initialText:(sel asString withoutSpaces)
 ].
 box action:[:aString | self withWaitCursorDo:[aBlock value:aString]].
 box showAtPointer
-!
+!!
 askForMethodCategory
 |someCategories box txt|
 someCategories := actualClass categories sort.
 ].
 box initialText:txt.
 box action:[:aString | ^ aString ].
 box showAtPointer.
 ^ nil
-!
+!!
 askForSelectorTitle:title
 "convenient method: setup enterBox with text from codeView or selected
 method for browsing based on a selector. Set action and launch box"
 box := self enterBoxTitle:title okText:'browse'.
 box initialText:(self selectorToSearchFor).
 box action:[:aString | aString isEmpty ifTrue:[^ nil]. ^ aString].
 box showAtPointer.
 ^ nil
-!
+!!
 askForSelectorTitle:title openWith:selector
 "convenient method: setup enterBox with text from codeView or selected
 method for browsing based on a selector. Set action and launch box"
 	    SystemBrowser perform:selector with:string
 	]
 ].
 "Created: 23.11.1995 / 14:11:34 / cg"
-!
+!!
 askForSelectorTitle:title openWith:selector and:arg
 "convenient method: setup enterBox with text from codeView or selected
 method for browsing based on a selector. Set action and launch box"
 	    SystemBrowser perform:selector with:string with:arg
 	]
 ].
 "Created: 23.11.1995 / 14:11:38 / cg"
-!
+!!
 busyLabel:what with:someArgument
 "set the title for some warning"
 self label:('System Browser - ' , (resources string:what with:someArgument))
-!
+!!
 checkSelectionChangeAllowedWithCompare:compareOffered
 "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"
 ].
 codeView accept.
 ^ true
 "Created: 24.11.1995 / 10:54:46 / cg"
-!
+!!
 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"
 ^ self checkSelectionChangeAllowedWithCompare:false
 "Created: 24.11.1995 / 11:03:33 / cg"
 "Modified: 24.11.1995 / 11:05:49 / cg"
-!
+!!
 classHierarchyDo:aBlock
 "eavluate the 2-arg block for every class,
 starting at Object; passing class and nesting level to the block."
 	    ].
 	    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 sortWith:subclasses.
 	subclasses do:[:aSubClass |
 	    self classHierarchyOf:aSubClass level:(level + 1) do:aBlock using:aDictionary
 	]
 ]
-!
+!!
 classesInFullProtocolHierarchy:aClass do:aBlock
 "evaluate aBlock for all non-striked out classes in
 the hierarchy"
 	    aBlock value:c
 	].
 	index := index - 1
 ]
-!
+!!
 classesInHierarchy:aClass do:aBlock
 |index|
 index := (classListView list size).
 	    aBlock value:c
 	].
 	index := index - 1
 ]
-!
+!!
 compileCode:someCode
 (ReadStream on:someCode) fileIn
-!
+!!
 enterBoxForBrowseTitle:title action:aBlock
 "convenient method: setup enterBox with text from codeView or selected
 method for method browsing based on className/variable"
 	aString notEmpty ifTrue:[
 	    self withWaitCursorDo:[aBlock value:aString]
 	].
 ].
 box showAtPointer
-!
+!!
 enterBoxForCodeSelectionTitle:title okText:okText
 "convenient method: setup enterBox with text from codeview"
 |sel box|
 sel := codeView selection.
 sel notNil ifTrue:[
 	box initialText:(sel asString withoutSeparators)
 ].
 ^ box
-!
+!!
 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
-!
+!!
 enterBoxTitle:title okText:okText
 "convenient method: setup enterBox"
 |box|
 box := EnterBox new.
 box title:(resources string:title) okText:(resources string:okText).
 ^ box
-!
+!!
 extractClassAndSelectorFromSelectionInto:aBlock
 "given a string which can be either 'class>>sel' or
 'class sel', extract className and selector, and call aBlock with
 the result."
 	]
 ].
 aBlock value:clsName value:sel value:isMeta
-!
+!!
 findClassOfVariable:aVariableName accessWith:aSelector
 "this method returns the class, in which a variable
 is defined;
 needs either #instVarNames or #classVarNames as aSelector."
 	homeClass := currentClass
 ] ifFalse:[
 "/        Transcript showCr:'starting search in ' , homeClass name.
 ].
 ^ homeClass
-!
+!!
 listBoxForCodeSelectionTitle:title okText:okText
 "convenient method: setup listBox with text from codeview"
 |sel box|
 sel := codeView selection.
 sel notNil ifTrue:[
 	box initialText:(sel asString withoutSeparators)
 ].
 ^ box
-!
+!!
 listBoxTitle:title okText:okText list:aList
 "convenient method: setup a listBox & return it"
 |box|
 		title:(resources string:title)
 		okText:(resources string:okText)
 		action:nil.
 box list:aList.
 ^ box
-!
+!!
 normalLabel
 "set the normal (inactive) window- and icon labels"
 |l il|
 	    il := l.
 	]
 ].
 self label:l.
 self iconLabel:il.
-!
+!!
 selectorToSearchFor
 "look in codeView and methodListView for a search-string when searching for selectors"
 |sel t|
 	] ifFalse:[
 	    sel := ''
 	]
 ].
 ^ sel
-!
+!!
 setAcceptAndExplainActionsForMethod
 "tell the codeView what to do on accept and explain"
 codeView acceptAction:[:theCode |
 	self showExplanation:(Explainer
 				explain:theSelection
 				in:theCode
 				forClass:actualClass)
 ].
-!
+!!
 setDoitActionForClass
 "tell the codeView what to do on doIt"
 "set self for doits. This allows accessing the current class
 	    receiver:currentClass
 	    notifying:codeView
 	    logged:false
 	    ifFail:nil
 ].
-!
+!!
 setSearchPattern:aString
 codeView setSearchPattern:aString
-!
+!!
 showExplanation:someText
 "show explanation from Parser"
 self information:someText
-!
+!!
 stringToSearchFor
 "look in codeView and methodListView for a search-string when searching for classes/names"
 |sel|
 	] ifFalse:[
 	    sel := ''
 	]
 ].
 ^ sel
-!
+!!
 warnLabel:what
 "set the title for some warning"
 self label:('System Browser WARNING: ' , what)
-!
+!!
 withSearchCursorDo:aBlock
 ^ self withCursor:(Cursor questionMark) do:aBlock
 "Created: 23.11.1995 / 14:11:14 / cg"
-! !
+!! !!
-!BrowserView methodsFor:'unused'!
+!!BrowserView methodsFor:'unused'!!
 listOfAllMethodCategoriesInHierarchy:aClass
 "answer a list of all method categories of the argument, aClass,
 and all of its superclasses"
 ].
 (newList size == 0) ifTrue:[^ nil].
 newList add:'* all *'.
 ^ newList asOrderedCollection sort
-!
+!!
 listOfAllSelectorsInCategory:aCategory inHierarchyOfClass:aClass
 "answer a list of all selectors in a given method category
 of the argument, aClass and its superclasses"
 	    ]
 	].
 ].
 (newList size == 0) ifTrue:[^ nil].
 ^ newList asOrderedCollection sort
-! !
+!! !!
-!BrowserView methodsFor:'variable list menu'!
+!!BrowserView methodsFor:'variable list menu'!!
 allClassOrInstVarRefsTitle:title access:access mods:modifications
 "show an enterbox for instVar to search for"
 self doClassMenu:[:currentClass |
 	].
 	box showAtPointer
 ]
 "Created: 23.11.1995 / 14:13:24 / cg"
-!
+!!
 allClassVarMods
 "show an enterbox for classVar to search for"
 self allClassOrInstVarRefsTitle:'class variable to browse modifications of:'
 				  access:#classVarNames
 				  mods:true
-!
+!!
 allClassVarRefs
 "show an enterbox for classVar to search for"
 self allClassOrInstVarRefsTitle:'class variable to browse references to:'
 				  access:#classVarNames
 				  mods:false
-!
+!!
 allInstVarMods
 "show an enterbox for instVar to search for"
 self allClassOrInstVarRefsTitle:'instance variable to browse modifications of:'
 				  access:#instVarNames
 				  mods:true
-!
+!!
 allInstVarRefs
 "show an enterbox for instVar to search for"
 self allClassOrInstVarRefsTitle:'instance variable to browse references to:'
 				  access:#instVarNames
 				  mods:false
-!
+!!
 classVarMods
 "show an enterbox for classVar to search for"
 self classVarRefsOrModsTitle:'class variable to browse modifications of:'
 				 mods:true
-!
+!!
 classVarRefs
 "show an enterbox for classVar to search for"
 self classVarRefsOrModsTitle:'class variable to browse references to:'
 				 mods:false
-!
+!!
 classVarRefsOrModsTitle:title mods:mods
 "show an enterbox for classVar to search for"
 self doClassMenu:[:currentClass |
 	].
 	box showAtPointer
 ]
 "Created: 23.11.1995 / 14:12:56 / cg"
-!
+!!
 enterBoxForVariableSearch:title
 |box sel|
 box := self enterBoxForCodeSelectionTitle:title okText:'browse'.
 		]
 	    ]
 	]
 ].
 ^ box
-!
+!!
 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
-!
+!!
 instVarRefsOrModsTitle:title mods:mods
 "show an enterbox for instvar to search for"
 self doClassMenu:[:currentClass |
 	].
 	box showAtPointer
 ]
 "Created: 23.11.1995 / 14:12:40 / cg"
-!
+!!
 varTypeInfo
 "show typical usage of a variable"
 |name idx classes values value msg cut names instCount subInstCount box
 ].
 box := InfoBox title:msg withCRs.
 box label:'variable type information'.
 box showAtPointer
-!
+!!
 variableListMenu
 |labels selectors|
 currentClass isNil ifTrue:[
 				).
 ].
 ^ PopUpMenu labels:(resources array:labels)
 		selectors:selectors
-!
+!!
 variableSelection:lineNr
 "variable selection changed"
 |name idx|
 "search for methods in the current category, which access the selected
 variable, and highlight them"
 self hilightMethodsInMethodCategoryList:true inMethodList:true.
 self autoSearch:name.
-! !
+!! !!
-!BrowserView methodsFor:'variable stuff'!
+!!BrowserView methodsFor:'variable stuff'!!
 hilightMethodsInMethodCategoryList
 "search for methods  which access the selected
 variable, and highlight them"
 self hilightMethodsInMethodCategoryList:true inMethodList:false
-!
+!!
 hilightMethodsInMethodCategoryList:inCat inMethodList:inMethods
 "search for methods  which access the selected
 variable, and highlight them"
 	    self setSearchPattern:name
 	]
 ]
 "Created: 23.11.1995 / 14:12:08 / cg"
-!
+!!
 hilightMethodsInMethodList
 "search for methods  which access the selected
 variable, and highlight them"
 self hilightMethodsInMethodCategoryList:false inMethodList:true
-!
+!!
 unhilightMethodCategories
 "unhighlight items in method list"
 variableListView isNil ifTrue:[^ self].
 	    methodCategoryListView attributeAt:entry put:nil.
 	]
 ].
-!
+!!
 unhilightMethods
 "unhighlight items in method list"
 variableListView isNil ifTrue:[^ self].
 	     methodListView attributeAt:entry put:nil.
 	].
 ].
-!
+!!
 updateVariableList
 |l subList last nameAccessSelector class oldSelection|
 variableListView isNil ifTrue:[^ self].
 oldSelection notNil ifTrue:[
 	variableListView selectElement:oldSelection.
 	self hilightMethodsInMethodCategoryList:true inMethodList:true.
 ]
+!! !!
+!!BrowserView class methodsFor:'documentation'!!
+version
+^ '$Header: /cvs/stx/stx/libtool/BrowserView.st,v 1.58 1995-12-07 12:26:14 cg Exp $'!! !!
+BrowserView initialize!!
+!
+classPrimitiveFunctions
+"show the classes primitiveFunctions in the codeView.
+Also, set accept action to change it."
+self classShowFrom:#primitiveFunctionsString
+		   set:#primitiveFunctions:
+		aspect:#primitiveFunctions
+	       default:'%{
+/*
+* any local C (helper) functions
+* come here (please, define as static)
+*/
+%}'
+!!
+classPrimitiveVariables
+"show the classes primitiveVariables in the codeView.
+Also, set accept action to change it."
+self classShowFrom:#primitiveVariablesString
+		   set:#primitiveVariables:
+		aspect:#primitiveVariables
+	       default:'%{
+/*
+* any local C variables
+* come here (please, define as static)
+*/
+%}'
+!!
+classPrintOut
+self classPrintOutWith:#printOutOn:
+!!
+classPrintOutFullProtocol
+self classPrintOutWith:#printOutFullProtocolOn:
+!!
+classPrintOutProtocol
+self classPrintOutWith:#printOutProtocolOn:
+!!
+classPrintOutWith:aSelector
+self doClassMenu:[:currentClass |
+	|printStream|
+	printStream := Printer new.
+	currentClass perform:aSelector with:printStream.
+	printStream close
+]
+!!
+classProtocols
+^ self
+!!
+classRefs
+self doClassMenu:[:currentClass |
+	self withSearchCursorDo:[
+	    SystemBrowser browseReferendsOf:currentClass name asSymbol
+	]
+]
+"Created: 23.11.1995 / 14:11:43 / cg"
+!!
+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 %1'.
+	count ~~ 0 ifTrue:[
+	   t := t , '\(with %2 subclass'.
+	   count ~~ 1 ifTrue:[
+		t := t , 'es'
+	   ].
+	   t := (t , ')')
+	].
+	t := t , ' ?'.
+	t := (resources string:t with:currentClass name with:count) 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 |
+		|didRemove|
+		didRemove := false.
+		"
+		 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:[
+			didRemove := true.
+			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
+		].
+"
+		didRemove ifTrue:[
+		    methodCategoryListView notNil ifTrue:[methodCategoryListView contents:nil].
+		    methodListView notNil ifTrue:[methodListView contents:nil].
+		    codeView contents:nil.
+		    codeView modified: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
+!!
+classShowFrom:getSelector set:setSelector aspect:aspectSymbol default:default
+"common helper for comment, primitive-stuff etc.
+show the string returned from the classes getSelector-method,
+Set acceptaction to change it via setSelector."
+self doClassMenu:[:currentClass |
+	|text|
+	text := currentClass perform:getSelector.
+	text isNil ifTrue:[
+	    text := default
+	].
+	codeView contents:text.
+	codeView modified:false.
+	codeView acceptAction:[:theCode |
+	    Object abortSignal catch:[
+		lockUpdates := true.
+		currentClass perform:setSelector with:theCode asString.
+		codeView modified:false.
+	    ].
+	    lockUpdates := false.
+	].
+	codeView explainAction:nil.
+	methodListView notNil ifTrue:[
+	    methodListView deselect
+	].
+	aspect := aspectSymbol.
+	self normalLabel
+]
+!!
+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."
+self doClassMenuWithSelection:[:cls :sel |
+	|browser|
+	cls isMeta ifTrue:[
+	    Smalltalk allBehaviorsDo:[:aClass |
+		aClass class == cls ifTrue:[
+		    browser := SystemBrowser browseClass:aClass.
+		    browser instanceProtocol:false.
+		    sel notNil ifTrue:[
+			browser switchToMethodNamed:sel
+		    ].
+		    ^ self
+		].
+	    ].
+	    self warn:'oops, no class for this metaclass'.
+	    ^ self
+	].
+	browser := SystemBrowser browseClass:cls.
+	cls hasMethods ifFalse:[
+	    browser instanceProtocol:false.
+	].
+	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
+"
+!!
+classSpawnFullProtocol
+"create a new browser, browsing current classes full protocol"
+self doClassMenuWithSelection:[:cls :sel |
+	SystemBrowser browseFullClassProtocol:cls
+]
+!!
+classSpawnHierarchy
+"create a new HierarchyBrowser browsing current class"
+self doClassMenuWithSelection:[:cls :sel |
+	SystemBrowser browseClassHierarchy:cls
+]
+!!
+classSpawnSubclasses
+"create a new browser browsing current class's subclasses"
+self doClassMenuWithSelection:[:cls :sel |
+	|subs|
+	subs := cls allSubclasses.
+	(subs notNil and:[subs size ~~ 0]) ifTrue:[
+	    SystemBrowser browseClasses:subs title:('subclasses of ' , cls name)
+	]
+]
+!!
+classUnload
+"unload an autoloaded class"
+|nm|
+self checkClassSelected ifFalse:[^ self].
+nm := currentClass name.
+currentClass unload.
+self switchToClassNamed:nm
+!!
+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:[:currentClass |
+	self withSearchCursorDo:[
+	    SystemBrowser browseUsesOf:currentClass
+	]
+]
+"Created: 23.11.1995 / 14:11:47 / cg"
+!!
+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|
+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 copyWithoutLast:5 "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:[:currentClass | aBlock value:currentClass value:sel]
+!! !!
+!!BrowserView methodsFor:'class list source administration'!!
+classCreateSourceContainerFor:aClass
+"let user specify the source-repository values for aClass"
+|box
+moduleDirectory subDirectory
+fileName specialFlags
+check y component info fn project|
+moduleDirectory := 'stx' asValue.
+subDirectory := '' asValue.
+(Project notNil and:[(project := Project current) notNil]) ifTrue:[
+	subDirectory value:(project name)
+].
+info := SourceCodeManager sourceInfoOfClass:aClass.
+info notNil ifTrue:[
+	(info includesKey:#module) ifTrue:[
+	    moduleDirectory value:(info at:#module).
+	].
+	(info includesKey:#directory) ifTrue:[
+	    subDirectory value:(info at:#directory).
+	].
+	(info includesKey:#expectedFileName) ifTrue:[
+	    fn := (info at:#expectedFileName).
+	] ifFalse:[
+	    (info includesKey:#classFileName) ifTrue:[
+		fn := (info at:#classFileName).
+	    ]
+	]
+].
+fn isNil ifTrue:[
+	fn := (Smalltalk fileNameForClass:aClass) , '.st'.
+].
+"/
+"/ should check for conflicts ...
+"/
+fileName := fn asValue.
+box := DialogBox new.
+box label:(resources string:'Repository information for %1' with:aClass name).
+component := box addTextLabel:(resources string:'CREATE_REPOSITORY' with:currentClass name) withCRs.
+component adjust:#left; borderWidth:0.
+y := box yPosition.
+component := box addTextLabel:(resources string:'Module:').
+component width:0.5; adjust:#right.
+box yPosition:y.
+component := box addInputFieldOn:moduleDirectory tabable:true.
+component width:0.5; left:0.5; immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine.
+box addVerticalSpace.
+y := box yPosition.
+component := box addTextLabel:'Package:'.
+component width:0.5; adjust:#right.
+box yPosition:y.
+component := box addInputFieldOn:subDirectory tabable:true.
+component width:0.5; left:0.5; immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine.
+box addVerticalSpace.
+y := box yPosition.
+component := box addTextLabel:'Filename:'.
+component width:0.5; adjust:#right.
+box yPosition:y.
+component := box addInputFieldOn:fileName tabable:true.
+component width:0.5; left:0.5; immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine.
+box addVerticalSpace.
+box addVerticalSpace.
+box addAbortButton; addOkButton.
+box showAtPointer.
+box accepted ifTrue:[
+	self halt.
+]
+"Modified: 25.11.1995 / 18:03:25 / cg"
+!!
+classCheckin
+"check a class into the source repository"
+self doClassMenu:[:currentClass |
+	|logMessage info|
+	(info := SourceCodeManager sourceInfoOfClass:currentClass) isNil ifTrue:[
+	    ^ self classCreateSourceContainerFor:currentClass
+	].
+	logMessage := Dialog
+			 request:'enter a log message:'
+			 initialAnswer:lastSourceLogMessage
+			 onCancel:nil.
+	logMessage notNil ifTrue:[
+	    lastSourceLogMessage := logMessage.
+	    self busyLabel:'checking in %1' with:currentClass name.
+	    (SourceCodeManager checkinClass:currentClass logMessage:logMessage) ifFalse:[
+		self warn:'checkin failed'.
+	    ].
+	    aspect == #revisionInfo ifTrue:[
+		self classListUpdate
+	    ].
+	    self normalLabel.
+	]
+]
+"Created: 23.11.1995 / 11:41:38 / cg"
+"Modified: 3.12.1995 / 13:28:30 / cg"
+!!
+classCompareWithNewestInRepository
+"open a diff-textView comparing the current (in-image) version
+with the most recent version found in the repository."
+self doClassMenu:[:currentClass |
+	|aStream comparedSource currentSource v rev revString|
+	rev := Dialog request:'compare to revision: (empty for newest)'.
+	rev notNil ifTrue:[
+	    rev withoutSpaces isEmpty ifTrue:[
+		self busyLabel:'extracting newest %1' with:currentClass name.
+		aStream := SourceCodeManager mostRecentSourceStreamForClassNamed:currentClass name.
+		revString := 'newest'
+	    ] ifFalse:[
+		self busyLabel:'extracting previous %1' with:currentClass name.
+		aStream := SourceCodeManager sourceStreamFor:currentClass revision:rev.
+		revString := rev
+	    ].
+	    comparedSource := aStream contents.
+	    aStream close.
+	    self busyLabel:'generating current source ...' with:nil.
+	    aStream := '' writeStream.
+	    currentClass fileOutOn:aStream withTimeStamp:false.
+	    currentSource := aStream contents.
+	    aStream close.
+	    self busyLabel:'comparing  ...' with:nil.
+	    v := DiffTextView
+		openOn:currentSource label:'current (' , currentClass revision , ')'
+		and:comparedSource label:'repository (' , revString , ')'.
+	    v label:'comparing ' , currentClass name.
+	    self normalLabel.
+	]
+]
+"Created: 14.11.1995 / 16:43:15 / cg"
+"Modified: 22.11.1995 / 22:17:08 / cg"
+!!
+classRevisionInfo
+"show current classes revision info in codeView"
+self doClassMenu:[:currentClass |
+	|aStream info info2 s rv|
+	aStream := WriteStream on:(String new:200).
+	currentClass notNil ifTrue:[
+	    self busyLabel:'extracting revision info' with:nil.
+	    info := currentClass revisionInfo.
+	    rv := currentClass binaryRevision.
+	    rv notNil ifTrue:[
+		aStream nextPutAll:'**** Loaded classes binary information ****'; cr; cr.
+		aStream nextPutAll:'  Binary based upon : ' , rv; cr.
+		aStream cr.
+	    ].
+	    info notNil ifTrue:[
+		aStream nextPutAll:'**** Loaded classes source information ****'; cr; cr.
+		s := info at:#repositoryPath ifAbsent:nil.
+		s notNil ifTrue:[
+		    aStream nextPut:'  Source repository : ' , s; cr
+		].
+		aStream nextPutAll:'  Filename ........ : ' , (info at:#fileName ifAbsent:'?'); cr.
+		aStream nextPutAll:'  Revision ........ : ' , (info at:#revision ifAbsent:'?'); cr.
+		aStream nextPutAll:'  Checkin date .... : ' , (info at:#date ifAbsent:'?') , ' ' , (info at:#time ifAbsent:'?'); cr.
+		aStream nextPutAll:'  Checkin user .... : ' , (info at:#user ifAbsent:'?'); cr.
+		(info2 := currentClass packageSourceCodeInfo) notNil ifTrue:[
+		    aStream nextPutAll:'  Repository: ..... : ' , (info2 at:#module ifAbsent:'?'); cr.
+		    aStream nextPutAll:'  Directory: ...... : ' , (info2 at:#directory ifAbsent:'?'); cr.
+		].
+		aStream nextPutAll:'  Container ....... : ' , (info at:#repositoryPathName ifAbsent:'?'); cr.
+		aStream cr.
+		SourceCodeManager notNil ifTrue:[
+		    aStream nextPutAll:'**** Repository information ****'; cr; cr.
+		    SourceCodeManager writeRevisionLogOf:currentClass to:aStream.
+		]
+	    ] ifFalse:[
+		aStream nextPutAll:'No revision info found'
+	    ]
+	].
+	codeView contents:(aStream contents).
+	codeView modified:false.
+	codeView acceptAction:nil.
+	codeView explainAction:nil.
+	methodListView notNil ifTrue:[
+	    methodListView deselect
+	].
+	aspect := #revisionInfo.
+	self normalLabel
+]
+"Created: 14.11.1995 / 16:43:15 / cg"
+"Modified: 7.12.1995 / 11:00:56 / cg"
+!!
+classLoadRevision
+"load a specific revision into the system - especially useful to
+upgrade a class to the newest revision"
+self doClassMenu:[:currentClass |
+	|aStream comparedSource currentSource v rev revString what|
+	rev := Dialog request:'load which revision: (empty for newest)'.
+	rev notNil ifTrue:[
+	    rev withoutSpaces isEmpty ifTrue:[
+		what := currentClass name , '(newest)'.
+		self busyLabel:'extracting %1' with:what.
+		aStream := SourceCodeManager mostRecentSourceStreamForClassNamed:currentClass name.
+		revString := 'newest'
+	    ] ifFalse:[
+		what := currentClass name , '(' , rev , ')'.
+		self busyLabel:'extracting %1' with:what.
+		aStream := SourceCodeManager sourceStreamFor:currentClass revision:rev.
+		revString := rev
+	    ].
+	    self busyLabel:'loading %1' with:what .
+	    [
+		Class withoutUpdatingChangesDo:[
+		    "/ rename the current class - for backup
+		    Smalltalk renameClass:currentClass to:currentClass name , '_saved'.
+		    aStream fileIn.
+		].
+	    ] valueNowOrOnUnwindDo:[
+		aStream close.
+		self normalLabel.
+	    ].
+	]
+]
+"Created: 14.11.1995 / 16:43:15 / cg"
+"Modified: 25.11.1995 / 10:44:38 / cg"
+!! !!
+!!BrowserView methodsFor:'class stuff'!!
+checkClassSelected
+"warn and return false, if no class is selected"
+currentClass isNil ifTrue:[
+	self warn:'select a class first'.
+	^ false
+].
+^ true
+!!
+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 compile:false).
+	    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
+!!
+classListUpdate
+RememberAspect ifTrue:[
+	aspect == #hierarchy ifTrue:[
+	    ^ self classHierarchy
+	].
+	aspect == #classInstVars ifTrue:[
+	    ^ self classClassInstVars
+	].
+	aspect == #comment ifTrue:[
+	    ^ self classComment
+	].
+	aspect == #primitiveDefinitions ifTrue:[
+	    ^ self classPrimitiveDefinitions
+	].
+	aspect == #primitiveFunctions ifTrue:[
+	    ^ self classPrimitiveFunctions
+	].
+	aspect == #primitiveVariables ifTrue:[
+	    ^ self classPrimitiveVariables
+	].
+	aspect == #revisionInfo ifTrue:[
+	    ^ self classRevisionInfo
+	].
+].
+self classDefinition
+"Created: 23.11.1995 / 11:28:58 / cg"
+"Modified: 23.11.1995 / 11:36:08 / cg"
+!!
+classSelection:lineNr
+"user clicked on a class line - show method categories"
+|cls oldSelector|
+(currentClassHierarchy notNil
+and:[fullProtocol]) ifTrue:[
+	oldSelector := currentSelector.
+	self updateMethodCategoryListWithScroll:false.
+	self updateMethodListWithScroll:false.
+	self updateVariableList.
+	^ self
+].
+cls := Smalltalk classNamed:classListView selectionValue withoutSpaces.
+cls notNil ifTrue:[
+	self switchToClass:cls.
+	self classSelectionChanged
+]
+!!
+classSelectionChanged
+|oldMethodCategory oldMethod oldSelector|
+self withWaitCursorDo:[
+	oldMethodCategory := currentMethodCategory.
+	oldMethod := currentMethod.
+	oldSelector := currentSelector.
+	showInstance ifTrue:[
+	    actualClass := acceptClass := currentClass
+	] ifFalse:[
+	    actualClass := acceptClass := currentClass class
+	].
+	currentMethodCategory := nil.
+	currentMethod := nil.
+	currentSelector := nil.
+	self updateVariableList.
+	self updateMethodCategoryList.
+	oldMethodCategory notNil ifTrue:[
+	    methodCategoryListView selectElement:oldMethodCategory.
+	    methodCategoryListView hasSelection 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.
+	    ].
+	] ifFalse:[
+"/            self classDefinition.
+self classListUpdate.
+	    codeView acceptAction:[:theCode |
+		codeView cursor:Cursor execute.
+		Object abortSignal catch:[
+		    (Compiler evaluate:theCode asString notifying:codeView compile:false)
+		    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
+	    ]
+	].
+	self setDoitActionForClass
+]
+"Created: 23.11.1995 / 11:32:03 / cg"
+!!
+doClassMenu:aBlock
+"a helper - check if class is selected and evaluate aBlock
+while showing waitCursor"
+self checkClassSelected ifTrue:[
+	self withWaitCursorDo:[aBlock value:currentClass]
+]
+!!
+listOfAllClassesInCategory:aCategory
+"return a list of all classes in a given category"
+|newList classes searchCategory nm|
+(aCategory = '* hierarchy *') ifTrue:[
+	newList := OrderedCollection new.
+	classes := Set new.
+	self classHierarchyDo:[:aClass :lvl|
+	    nm := aClass name.
+	    (classes includes:nm) ifFalse:[
+		classes add:nm.
+		newList add:(String new:lvl) , nm
+	    ]
+	].
+	^ newList
+].
+newList := Set new.
+(aCategory = '* all *') ifTrue:[
+	Smalltalk allBehaviorsDo:[:aClass |
+	    newList add:aClass name
+	]
+] ifFalse:[
+	(aCategory = '* no category *') ifTrue:[
+	    searchCategory := nil
+	] ifFalse:[
+	    searchCategory := aCategory
+	].
+	Smalltalk allBehaviorsDo:[:aClass |
+	    |thisCategory|
+	    aClass isMeta ifFalse:[
+		thisCategory := aClass category.
+		((thisCategory = searchCategory)
+		or:[thisCategory = aCategory]) ifTrue:[
+		    newList add:aClass name
+		]
+	    ]
+	]
+].
+(newList size == 0) ifTrue:[^ nil].
+^ newList asOrderedCollection sort
+!!
+listOfClassHierarchyOf:aClass
+"return a hierarchy class-list"
+|startClass classes thisOne|
+showInstance ifTrue:[
+	startClass := aClass
+] ifFalse:[
+	startClass := aClass class.
+].
+classes := startClass allSuperclasses.
+thisOne := Array with:startClass.
+classes notNil ifTrue:[
+	classes := classes reverse , thisOne.
+] ifFalse:[
+	classes := thisOne
+].
+fullProtocol ifFalse:[
+	classes := classes , startClass allSubclassesInOrder
+].
+^ classes collect:[:c | c name]
+!!
+renameCurrentClassTo:aString
+"helper - do the rename"
+self doClassMenu:[:currentClass |
+	|oldName oldSym newSym cls|
+	(cls := Smalltalk classNamed:aString) notNil ifTrue:[
+	    (self confirm:(resources string:'WARN_RENAME' with:aString with:cls category))
+		ifFalse:[^ self]
+	].
+	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.
+	    SystemBrowser browseReferendsOf:oldSym warnIfNone:false
+	]
+]
+"Created: 25.11.1995 / 13:02:53 / cg"
+!!
+switchToClass:newClass
+"switch to some other class;
+keep instance protocol as it was ..."
+|cls meta|
+fullProtocol ifTrue:[^ self].
+cls := newClass.
+(meta := cls isMeta) ifTrue:[
+	cls := cls soleInstance
+].
+currentClass notNil ifTrue:[
+	currentClass removeDependent:self
+].
+currentClass := cls.
+showInstance ifTrue:[
+actualClass := acceptClass := cls.
+] ifFalse:[
+actualClass := acceptClass := cls class.
+].
+currentClass notNil ifTrue:[
+	currentClass addDependent:self.
+].
+self normalLabel.
+"Modified: 1.9.1995 / 01:04:05 / claus"
+!!
+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
+!!
+switchToClassNamed:aString
+|meta str classSymbol theClass newCat element|
+meta := false.
+str := aString.
+classSymbol := aString asSymbolIfInterned.
+classSymbol isNil ifTrue:[
+	(aString endsWith:'class') ifTrue:[
+	    str := aString copyWithoutLast:5.
+	    classSymbol := str asSymbolIfInterned.
+	    classSymbol isNil ifTrue:[
+		^ self
+	    ].
+	    meta := true
+	].
+].
+theClass := Smalltalk at:classSymbol.
+(theClass isNil and:[str endsWith:'class']) ifTrue:[
+	str := str copyWithoutLast:5.
+	classSymbol := str asSymbolIfInterned.
+	classSymbol isNil ifTrue:[
+	    ^ self
+	].
+	meta := true.
+	theClass := Smalltalk at:classSymbol.
+].
+theClass == currentClass ifTrue:[^ self].
+theClass isBehavior ifTrue:[
+	classCategoryListView notNil ifTrue:[
+	    currentClassHierarchy isNil ifTrue:[
+		((newCat := theClass category) ~= currentClassCategory) ifTrue:[
+		    currentClassCategory := newCat.
+		    newCat isNil ifTrue:[
+			element := '* no category *'
+		    ] ifFalse:[
+			element := newCat.
+		    ].
+		    classCategoryListView selectElement:element.
+		    "/ classCategoryListView makeSelectionVisible.
+		]
+	    ]
+	].
+	self updateClassList.
+	self switchToClass:theClass.
+	classListView selectElement:str.
+	self instanceProtocol:meta not.
+	self classSelectionChanged
+]
+"Modified: 1.9.1995 / 01:41:35 / claus"
+!!
+templateFor:className in:cat
+"return a class definition template - be smart in what is offered initially"
+|aString name i|
+name := 'NewClass'.
+i := 1.
+[name knownAsSymbol and:[Smalltalk includesKey:name asSymbol]] whileTrue:[
+	i := i + 1.
+	name := 'NewClass' , i printString
+].
+aString := className , ' subclass:#' , name , '
+	instanceVariableNames: ''''
+	classVariableNames: ''''
+	poolDictionaries: ''''
+	category: '''.
+cat notNil ifTrue:[
+	aString := aString , cat
+].
+aString := aString , '''
+"
+Replace ''' , className , ''', ''', name , ''' and
+the empty string arguments by true values.
+Install (or change) the class by ''accepting'',
+either via the menu or the keyboard (usually CMD-A).
+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.
+"
+'.
+^ aString
+!!
+updateClassList
+self updateClassListWithScroll:true
+!!
+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:[
+	    currentClassHierarchy notNil ifTrue:[
+		classes := self listOfClassHierarchyOf:currentClassHierarchy
+	    ]
+	].
+	classListView list = classes ifFalse:[
+	    scroll ifTrue:[
+		classListView contents:classes
+	    ] ifFalse:[
+		classListView setContents:classes
+	    ].
+	    oldClassName notNil ifTrue:[
+		classListView setContents:classes.
+		classListView selectElement:oldClassName
+	    ] ifFalse:[
+		variableListView notNil ifTrue:[variableListView contents:nil]
+	    ]
+	].
+	scroll ifTrue:[
+	    fullProtocol ifTrue:[
+		classListView scrollToBottom
+	    ]
+	]
+]
+!! !!
+!!BrowserView methodsFor:'class-method list menu'!!
+classMethodFileOutAll
+"fileout all methods into one source file"
+|list classString selectorString cls mth outStream fileName append
+fileBox|
+append := false.
+fileBox := FileSaveBox
+			title:(resources string:'save methodss in:')
+			okText:(resources string:'save')
+			abortText:(resources string:'cancel')
+			action:[:fName | fileName := fName].
+fileBox appendAction:[:fName | fileName := fName. append := true].
+fileBox initialText:'some_methods.st'.
+Project notNil ifTrue:[
+	fileBox directory:Project currentProjectDirectory
+].
+fileBox showAtPointer.
+fileName notNil ifTrue:[
+	"
+	 if file exists, save original in a .sav file
+	"
+	fileName asFilename exists ifTrue:[
+	    fileName asFilename copyTo:(fileName , '.sav')
+	].
+	append ifTrue:[
+	    outStream := FileStream appendingOldFileNamed:fileName
+	] ifFalse:[
+	    outStream := FileStream newFileNamed:fileName.
+	].
+	outStream isNil ifTrue:[
+	    ^ self warn:'cannot create: %1' with:fileName
+	].
+	self withWaitCursorDo:[
+	    list := classMethodListView list.
+	    list do:[:line |
+		self busyLabel:'writing: ' with:line.
+		classString := self classFromClassMethodString:line.
+		selectorString := self selectorFromClassMethodString:line.
+		((classString ~= 'Metaclass') and:[classString endsWith:'class']) ifTrue:[
+		    classString := classString copyWithoutLast:5 "copyTo:(classString size - 5)".
+		    cls := (Smalltalk at:classString asSymbol).
+		    cls := cls class
+		] ifFalse:[
+		    cls := (Smalltalk at:classString asSymbol).
+		].
+		cls isNil ifTrue:[
+		    self warn:'oops class %1 is gone' with:classString
+		] ifFalse:[
+		    mth := cls compiledMethodAt:(selectorString asSymbol).
+		    Class fileOutErrorSignal handle:[:ex |
+			|box|
+			box := YesNoBox
+				    title:('fileOut error: '
+					   , ex errorString
+					   , '\\continue anyway ?') withCRs
+				    yesText:'continue'
+				    noText:'abort'.
+			box confirm ifTrue:[
+			    ex proceed
+			].
+			self normalLabel.
+			^ self
+		    ] do:[
+			cls fileOutMethod:mth on:outStream.
+		    ]
+		]
+	    ].
+	    outStream close.
+	    self normalLabel.
+	]
+]
+!!
+classMethodMenu
+|labels selectors|
+labels := #(
+				'fileOut'
+				'fileOut all'
+				'printOut'
+				'-'
+				'spawn'
+				'spawn class'
+				'spawn full protocol'
+				'spawn hierarchy'
+				'-'
+				'senders ...'
+				'implementors ...'
+				'globals ...'
+"/                              '-'
+"/                              'breakpoint'
+"/                              'trace'
+"/                              'trace sender'
+				'-'
+				'remove'
+	       ).
+selectors := #(
+				methodFileOut
+				classMethodFileOutAll
+				methodPrintOut
+				nil
+				methodSpawn
+				classSpawn
+				classSpawnFullProtocol
+				classSpawnHierarchy
+				nil
+				methodSenders
+				methodImplementors
+				methodGlobalReferends
+"/                              nil
+"/                              methodBreakPoint
+"/                              methodTrace
+"/                              methodTraceSender
+				nil
+				methodRemove
+		  ).
+^ PopUpMenu labels:(resources array:labels)
+		selectors:selectors
+!! !!
+!!BrowserView methodsFor:'class-method stuff'!!
+classFromClassMethodString:aString
+"helper for classMethod-list - extract class name from the string"
+"/    |pos|
+"/
+"/    pos := aString indexOf:(Character space).
+"/    ^ aString copyTo:(pos - 1)
+^ aString upTo:Character space
+!!
+classMethodSelection:lineNr
+"user clicked on a class/method line - show code"
+|cls string classString selectorString meta|
+string := classMethodListView selectionValue.
+classString := self classFromClassMethodString:string.
+selectorString := self selectorFromClassMethodString:string.
+((classString ~= 'Metaclass') and:[classString endsWith:'class']) ifTrue:[
+	classString := classString copyWithoutLast:5 "copyTo:(classString size - 5)".
+	meta := true.
+] ifFalse:[
+	meta := false.
+].
+self switchToClass:(Smalltalk at:classString asSymbol).
+meta ifTrue:[cls := currentClass class] ifFalse:[cls := currentClass].
+actualClass := acceptClass := cls.
+currentClass isNil ifTrue:[
+	self warn:'oops class is gone'
+] ifFalse:[
+	currentClassCategory := currentClass category.
+	currentSelector := selectorString asSymbol.
+	currentMethod := actualClass compiledMethodAt:currentSelector.
+	currentMethod isNil ifTrue:[
+	    self warn:'oops method is gone'
+	] ifFalse:[
+	    currentMethodCategory := currentMethod category.
+	].
+	self methodSelectionChanged
+].
+self setDoitActionForClass
+"Modified: 31.8.1995 / 11:56:02 / claus"
+!!
+selectorFromClassMethodString:aString
+"helper for classMethod-list - extract selector from the string"
+|pos|
+pos := aString indexOf:(Character space).
+^ aString copyFrom:(pos + 1)
+!! !!
+!!BrowserView methodsFor:'help'!!
+helpTextFor:aComponent
+|s|
+aComponent == classCategoryListView ifTrue:[
+	s := 'HELP_CCAT_LIST'
+].
+aComponent == classListView ifTrue:[
+	fullProtocol ifTrue:[
+	    s := 'HELP_PCLASS_LIST'
+	] ifFalse:[
+	    currentClassHierarchy notNil ifTrue:[
+		s := 'HELP_HCLASS_LIST'
+	    ] ifFalse:[
+		s := 'HELP_CLASS_LIST'
+	    ]
+	]
+].
+aComponent == methodCategoryListView ifTrue:[
+	s := 'HELP_MCAT_LIST'
+].
+aComponent == methodListView ifTrue:[
+	s := 'HELP_METHOD_LIST'
+].
+aComponent == variableListView ifTrue:[
+	s := 'HELP_VAR_LIST'
+].
+aComponent == codeView ifTrue:[
+	fullClass ifTrue:[
+	    s := 'HELP_FULLCODE_VIEW'
+	] ifFalse:[
+	    s := 'HELP_CODE_VIEW'
+	]
+].
+(aComponent == instanceToggle
+or:[aComponent == classToggle]) ifTrue:[
+	s := 'HELP_INST_CLASS_TOGGLE'
+].
+aComponent == classMethodListView ifTrue:[
+	s := 'HELP_CLSMTHOD_LIST'
+].
+s notNil ifTrue:[
+	^ resources string:s
+].
+^ nil
+"Modified: 31.8.1995 / 19:11:39 / claus"
+!! !!
+!!BrowserView methodsFor:'initialize / release'!!
+autoSearch:aString
+"used with class-method list browsing. If true,
+selecting an entry from the list will automatically
+search for the searchstring in the codeView"
+self setSearchPattern:aString.
+autoSearch := aString
+!!
+destroy
+"relese dependant - destroy popups"
+Smalltalk removeDependent:self.
+currentClass notNil ifTrue:[
+	currentClass removeDependent:self.
+	currentClass := nil
+].
+super destroy
+!!
+initialize
+super initialize.
+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).
+	"
+	 tell classCategoryListView to ask for the menu
+	"
+	v menuHolder:self; menuPerformer:self; menuMessage:#classCategoryMenu.
+].
+v := classListView.
+v notNil ifTrue:[
+	v action:[:lineNr | self classSelection:lineNr].
+	v selectConditionBlock:checkBlock.
+	v ignoreReselect:false.
+	"
+	 tell classListView to ask for the menu
+	"
+	v menuHolder:self; menuPerformer:self; menuMessage:#classMenu.
+].
+v := methodCategoryListView.
+v notNil ifTrue:[
+	v action:[:lineNr | self methodCategorySelection:lineNr].
+	v selectConditionBlock:checkBlock.
+	v ignoreReselect:false.
+	"
+	 tell methodCategoryListView to ask for the menu
+	"
+	v menuHolder:self; menuPerformer:self; menuMessage:#methodCategoryMenu.
+].
+v := methodListView.
+v notNil ifTrue:[
+	v action:[:lineNr | self methodSelection:lineNr].
+	v selectConditionBlock:checkBlock.
+	v ignoreReselect:false.
+	"
+	 tell methodListView to ask for the menu
+	"
+	v menuHolder:self; menuPerformer:self; menuMessage:#methodMenu.
+].
+v := classMethodListView.
+v notNil ifTrue:[
+	v action:[:lineNr | self classMethodSelection:lineNr].
+	v selectConditionBlock:checkBlock.
+	v ignoreReselect:false.
+	"
+	 tell classMethodListView to ask for the menu
+	"
+	v menuHolder:self; menuPerformer:self; menuMessage:#classMethodMenu.
+].
+v := variableListView.
+v notNil ifTrue:[
+	v action:[:lineNr | self variableSelection:lineNr].
+	v ignoreReselect:false.
+	v toggleSelect:true.
+	v menuHolder:self; menuPerformer:self; menuMessage:#variableListMenu.
+].
+"
+normal browsers show the top at first;
+hierarchy and fullProtocol browsers better show the end
+initially
+"
+currentClassHierarchy notNil ifTrue:[
+	classListView scrollToBottom.
+]
+!!
+terminate
+(self checkSelectionChangeAllowed) ifTrue:[
+	super terminate
+]
+!!
+title:someString
+myLabel := someString.
+self label:someString.
+!! !!
+!!BrowserView methodsFor:'initialize subviews'!!
+createClassListViewIn:frame
+"setup the classlist subview, with its toggles"
+|v panel|
+self createTogglesIn:frame.
+"
+oldstyle had no variableList ...
+"
+"/    v := ScrollableView for:SelectionInListView in:frame.
+"/    v origin:(0.0 @ 0.0)
+"/      extent:[frame width
+"/            @
+"/           (frame height
+"/            - ViewSpacing
+"/            - instanceToggle height
+"/            - instanceToggle borderWidth
+"/            + v borderWidth)].
+"/
+"/    classListView := v scrolledView
+panel := VariableVerticalPanel
+		    origin:(0.0 @ 0.0)
+		    corner:[frame width
+			    @
+			    (frame height
+			      - ViewSpacing
+			      - instanceToggle height
+			      "-" "+ instanceToggle borderWidth "
+			      + v borderWidth)]
+			in:frame.
+v := ScrollableView for:SelectionInListView in:panel.
+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.7) corner:(1.0 @ 1.0).
+variableListView := v scrolledView.
+!!
+createCodeViewIn:aView
+"setup the code view"
+^ self createCodeViewIn:aView at:0.25
+!!
+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"
+|h halfSpace classAction instanceAction|
+classAction := [self instanceProtocol:false].
+instanceAction := [self instanceProtocol:true].
+halfSpace := ViewSpacing // 2.
+instanceToggle := Toggle label:(resources at:'instance') in:aFrame.
+h := instanceToggle heightIncludingBorder.
+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 heightIncludingBorder.
+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 bottomInset:halfSpace.
+	classToggle bottomInset:halfSpace.
+	instanceToggle leftInset:halfSpace.
+	classToggle leftInset:halfSpace.
+	instanceToggle rightInset:ViewSpacing - halfSpace.
+	classToggle rightInset:ViewSpacing - halfSpace.
+].
+!!
+focusSequence
+|s|
+s := OrderedCollection new.
+classCategoryListView notNil ifTrue:[
+	s add:classCategoryListView
+].
+classListView notNil ifTrue:[
+	s add:classListView
+].
+"/    variableListView notNil ifTrue:[
+"/        s add:variableListView
+"/    ].
+instanceToggle notNil ifTrue:[
+	s add:instanceToggle.
+].
+methodCategoryListView notNil ifTrue:[
+	s add:methodCategoryListView
+].
+methodListView notNil ifTrue:[
+	s add:methodListView
+].
+classMethodListView notNil ifTrue:[
+	s add:classMethodListView
+].
+s add:codeView.
+^ s
+!!
+setupForAll
+"create subviews for a full browser"
+|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.
+v := HVScrollableView for:SelectionInListView
+			  miniScrollerH:true miniScrollerV:false
+			  in:hpanel.
+v origin:(0.0 @ 0.0) corner:(0.25 @ 1.0).
+classCategoryListView := v scrolledView.
+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 origin:(0.5 @ 0.0) corner:(0.75 @ 1.0).
+methodCategoryListView := v scrolledView.
+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 createCodeViewIn:vpanel
+!!
+setupForClass:aClass
+"create subviews for browsing a single class"
+|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.5 @ 1.0)in:hpanel.
+self createTogglesIn:frame.
+v := ScrollableView for:SelectionInListView in:frame.
+v origin:(0.0 @ 0.0)
+extent:[frame width
+	      @
+	      (frame height
+	       - ViewSpacing
+	       - instanceToggle height
+	       - instanceToggle borderWidth
+	       + v borderWidth)].
+methodCategoryListView := v scrolledView.
+v := ScrollableView for:SelectionInListView in:hpanel.
+v origin:(0.5 @ 0.0) corner:(1.0 @ 1.0).
+methodListView := v scrolledView.
+self createCodeViewIn:vpanel.
+self switchToClass:aClass.
+actualClass := acceptClass := aClass.
+self updateMethodCategoryList.
+self updateMethodList.
+self updateCodeView.
+self classDefinition.
+!!
+setupForClass:aClass methodCategory:aMethodCategory
+"setup subviews to browse a method category"
+|vpanel v|
+vpanel := VariableVerticalPanel
+			origin:(0.0 @ 0.0) corner:(1.0 @ 1.0)
+			    in:self.
+v := ScrollableView for:SelectionInListView in:vpanel.
+v origin:(0.0 @ 0.0) corner:(1.0 @ 0.25).
+methodListView := v scrolledView.
+self createCodeViewIn:vpanel.
+currentClassCategory := aClass category.
+self switchToClass:aClass.
+actualClass := acceptClass := aClass.
+currentMethodCategory := aMethodCategory.
+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 := acceptClass := aClass.
+currentSelector := selector.
+currentMethod := currentClass compiledMethodAt:selector.
+currentMethodCategory := currentMethod category.
+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
+!!
+setupForClassHierarchy:aClass
+"setup subviews to browse a class hierarchy"
+|vpanel hpanel frame v cls|
+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.
+cls := aClass.
+cls isMeta ifTrue:[
+	cls := cls soleInstance
+].
+currentClassHierarchy := currentClass := actualClass := cls.
+self updateClassList.
+classListView selectElement:aClass name; makeSelectionVisible.
+self updateMethodCategoryList.
+self updateMethodList.
+self updateCodeView.
+aClass isMeta ifTrue:[
+	self instanceProtocol:false
+].
+!!
+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]) asOrderedCollection.
+classListView list:(l sort).
+self updateMethodCategoryList.
+self updateMethodList.
+self updateCodeView
+!!
+setupForFullClass
+"setup subviews to browse a class as full text"
+|vpanel hpanel 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.
+v := ScrollableView for:SelectionInListView in:hpanel.
+v origin:(0.0 @ 0.0) corner:(0.5 @ 1.0).
+classCategoryListView := v scrolledView.
+classCategoryListView contents:(self listOfAllClassCategories).
+v := ScrollableView for:SelectionInListView in:hpanel.
+v origin:(0.5 @ 0.0) corner:(1.0 @ 1.0).
+classListView := v scrolledView.
+self createCodeViewIn:vpanel.
+fullClass := true.
+self updateCodeView
+!!
+setupForFullClassProtocol:aClass
+"setup subviews to browse a classes full protocol"
+|vpanel hpanel frame v cls|
+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.
+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 createCodeViewIn:vpanel at:0.4.
+cls := aClass.
+cls isMeta ifTrue:[
+	cls := cls soleInstance
+].
+currentClassHierarchy := actualClass := acceptClass := currentClass := cls.
+fullProtocol := true.
+self updateClassList.
+self updateMethodCategoryList.
+self updateMethodList.
+self updateCodeView.
+self updateVariableList.
+aClass isMeta ifTrue:[
+	self instanceProtocol:false
+].
+!!
+setupForList:aList
+"setup subviews to browse methods from a list"
+|vpanel v|
+vpanel := VariableVerticalPanel
+			origin:(0.0 @ 0.0)
+			corner:(1.0 @ 1.0)
+			    in:self.
+v := ScrollableView for:SelectionInListView in:vpanel.
+v origin:(0.0 @ 0.0) corner:(1.0 @ 0.25).
+classMethodListView := v scrolledView.
+classMethodListView contents:aList.
+self createCodeViewIn:vpanel.
+aList size == 1 ifTrue:[
+	classMethodListView selection:1.
+	self classMethodSelection:1.
+].
+self updateCodeView
+!! !!
+!!BrowserView methodsFor:'method category list menu'!!
+methodCategoryCopyCategory
+"show the enter box to copy from an existing method category"
+|title box|
+showInstance ifTrue:[
+	title := 'class to copy instance method category from:'
+] ifFalse:[
+	title := 'class to copy class method category from:'
+].
+box := self listBoxTitle:title
+		      okText:'ok'
+			list:(Smalltalk allClasses collect:[:cls | cls name]) asArray sort.
+box action:[:aString | self copyMethodsFromClass:aString].
+box showAtPointer
+!!
+methodCategoryCreateAccessMethods
+"create access methods for all instvars"
+self checkClassSelected ifFalse:[^ self].
+showInstance ifFalse:[
+	self warn:'select instance - and try again'.
+	^ self.
+].
+self withWaitCursorDo:[
+	|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:[
+		Transcript showCr:'method ''', name , ''' already present'
+	    ].
+	    (currentClass implements:((name , ':') asSymbol)) ifFalse:[
+		source := (name , ':something\    "set ' , name , '"\\    ' , name , ' := something.') withCRs.
+		Compiler compile:source forClass:currentClass inCategory:'accessing'.
+	    ] ifTrue:[
+		Transcript showCr:'method ''', name , ':'' already present'
+	    ].
+	].
+	self updateMethodCategoryListWithScroll:false.
+	self updateMethodListWithScroll:false
+]
+!!
+methodCategoryCreateDocumentationMethods
+"create empty documentation methods"
+|cls histStream|
+self checkClassSelected ifFalse:[^ self].
+cls := currentClass class.
+self withWaitCursorDo:[
+	|nm names source|
+	"/ add version method containing RCS template
+	"/ but only if not already present.
+	(cls implements:#version) ifFalse:[
+	    Compiler compile:
+'version
+"
+$' , 'Header$
+"
+'                   forClass:cls
+		  inCategory:'documentation'.
+	].
+	"/ add documentation method containing doc template
+	"/ but only if not already present.
+	(cls implements:#documentation) ifFalse:[
+	    Compiler compile:
+'documentation
+"
+documentation to be added.
+"
+'                   forClass:cls
+		  inCategory:'documentation'.
+	].
+	"/ add examples method containing examples template
+	"/ but only if not already present.
+	(cls implements:#examples) ifFalse:[
+	    Compiler compile:
+'examples
+"
+examples to be added.
+"
+'                   forClass:cls
+		  inCategory:'documentation'.
+	].
+	"/ add history method containing created-entry
+	"/ but only if not already present.
+	(cls implements:#history) ifFalse:[
+	    histStream := ReadWriteStream on: String new.
+	    histStream nextPutAll: 'history'; cr.
+	    HistoryLine isBehavior ifTrue:[
+		histStream nextPutAll: (HistoryLine newCreated printString); cr.
+	    ] ifFalse:[
+		histStream cr.
+	    ].
+	    Compiler compile:(histStream contents)
+		    forClass:cls
+		  inCategory:'documentation'.
+	].
+	self instanceProtocol:false.
+	self switchToMethodNamed:#documentation
+"/        self updateMethodCategoryListWithScroll:false.
+"/        self updateMethodListWithScroll:false
+]
+!!
+methodCategoryFileOut
+"fileOut all methods in the selected methodcategory of
+the current class"
+self checkClassSelected ifFalse:[^ self].
+self whenMethodCategorySelected:[
+	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.
+]
+!!
+methodCategoryFileOutAll
+"fileOut all methods in the selected methodcategory of
+the current class"
+self whenMethodCategorySelected:[
+	|fileName outStream|
+	fileName := currentMethodCategory , '.st'.
+	fileName replaceAll:Character space by:$_.
+	"
+	 this test allows a smalltalk to be built without Projects/ChangeSets
+	"
+	Project notNil ifTrue:[
+	    fileName := Project currentProjectDirectory , fileName.
+	].
+	"
+	 if file exists, save original in a .sav file
+	"
+	fileName asFilename exists ifTrue:[
+	    fileName asFilename copyTo:(fileName , '.sav')
+	].
+	outStream := FileStream newFileNamed:fileName.
+	outStream isNil ifTrue:[
+	    ^ self warn:'cannot create: %1' with:fileName
+	].
+	self busyLabel:'saving: ' with:currentMethodCategory.
+	Class fileOutErrorSignal handle:[:ex |
+	    self warn:'cannot create: %1' with:ex parameter.
+	    ex return
+	] do:[
+	    Smalltalk allBehaviorsDo:[:class |
+		|hasMethodsInThisCategory|
+		hasMethodsInThisCategory := false.
+		class methodArray do:[:method |
+		    method category = currentMethodCategory ifTrue:[
+			hasMethodsInThisCategory := true
+		    ]
+		].
+		hasMethodsInThisCategory ifTrue:[
+		    class fileOutCategory:currentMethodCategory on:outStream.
+		    outStream cr
+		].
+		hasMethodsInThisCategory := false.
+		class class methodArray do:[:method |
+		    method category = currentMethodCategory ifTrue:[
+			hasMethodsInThisCategory := true
+		    ]
+		].
+		hasMethodsInThisCategory ifTrue:[
+		    class class fileOutCategory:currentMethodCategory on:outStream.
+		    outStream cr
+		]
+	    ].
+	].
+	outStream close.
+	self normalLabel.
+].
+!!
+methodCategoryFindAnyMethod
+|box|
+box := self enterBoxForSearchSelectorTitle:'method selector to search for:'.
+box action:[:aString | self switchToAnyMethodNamed:aString].
+box showAtPointer
+!!
+methodCategoryFindMethod
+|box|
+box := self enterBoxForSearchSelectorTitle:'method selector to search for:'.
+box action:[:aString | self switchToMethodNamed:aString].
+box showAtPointer
+!!
+methodCategoryMenu
+|labels selectors i|
+currentClass isNil ifTrue:[
+	methodCategoryListView flash.
+	^ nil
+].
+currentMethodCategory isNil ifTrue:[
+	labels := #(
+		    'find method here ...'
+		    'find method ...'
+		    '-'
+		    'new category ...'
+		    'copy category ...'
+		    'create access methods'
+		   ).
+	selectors := #(
+		    methodCategoryFindMethod
+		    methodCategoryFindAnyMethod
+		    nil
+		    methodCategoryNewCategory
+		    methodCategoryCopyCategory
+		    methodCategoryCreateAccessMethods
+		   ).
+] ifFalse:[
+	labels := #(
+		    'fileOut'
+		    'fileOut all'
+		    'printOut'
+		    '-'
+		    'SPAWN_METHODCATEGORY'
+		    'spawn category'
+		    '-'
+		    'find method here ...'
+		    'find method ...'
+		    '-'
+		    'new category ...'
+		    'copy category ...'
+		    'create access methods'
+		    'rename ...'
+		    'remove'
+		   ).
+	selectors := #(
+		    methodCategoryFileOut
+		    methodCategoryFileOutAll
+		    methodCategoryPrintOut
+		    nil
+		    methodCategorySpawn
+		    methodCategorySpawnCategory
+		    nil
+		    methodCategoryFindMethod
+		    methodCategoryFindAnyMethod
+		    nil
+		    methodCategoryNewCategory
+		    methodCategoryCopyCategory
+		    methodCategoryCreateAccessMethods
+		    methodCategoryRename
+		    methodCategoryRemove
+		   ).
+].
+showInstance ifFalse:[
+	labels := labels copy.
+	selectors := selectors copy.
+	i := labels indexOf:'create access methods'.
+	labels at:i put:'create documentation stubs'.
+	selectors at:i put:#methodCategoryCreateDocumentationMethods
+].
+^ PopUpMenu labels:(resources array:labels)
+		 selectors:selectors
+!!
+methodCategoryNewCategory
+"show the enter box to add a new method category.
+Offer existing superclass categories in box to help avoiding
+useless typing."
+|someCategories existingCategories box|
+actualClass notNil ifTrue:[
+	someCategories := actualClass allCategories
+] ifFalse:[
+	"
+	 mhmh - offer some typical categories ...
+	"
+	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
+!!
+methodCategoryPrintOut
+|printStream|
+self checkClassSelected ifFalse:[^ self].
+self whenMethodCategorySelected:[
+	printStream := Printer new.
+	actualClass printOutCategory:currentMethodCategory on:printStream.
+	printStream close
+]
+!!
+methodCategoryRemove
+"show number of methods to remove and query user"
+|count t box|
+currentMethodCategory notNil ifTrue:[
+	count := 0.
+	actualClass methodArray do:[:aMethod |
+	    (aMethod category = currentMethodCategory) ifTrue:[
+		count := count + 1
+	    ]
+	].
+	(count == 0) ifTrue:[
+	    currentMethodCategory := nil.
+	    currentMethod := currentSelector := nil.
+	    self updateMethodCategoryListWithScroll:false.
+	    self updateMethodList
+	] ifFalse:[
+	    (count == 1) ifTrue:[
+		t := 'remove %1\(with 1 method) ?'
+	    ] ifFalse:[
+		t := 'remove %1\(with %2 methods) ?'
+	    ].
+	    t := resources string:t with:currentMethodCategory with:count printString.
+	    t := t withCRs.
+	    box := YesNoBox
+		       title:t
+		       yesText:(resources at:'remove')
+		       noText:(resources at:'abort').
+	    box confirm ifTrue:[
+		actualClass methodArray do:[:aMethod |
+		    (aMethod category = currentMethodCategory) ifTrue:[
+			actualClass
+			    removeSelector:(actualClass selectorAtMethod:aMethod)
+		    ]
+		].
+		currentMethodCategory := nil.
+		currentMethod := currentSelector := nil.
+		self updateMethodCategoryList.
+		self updateMethodList
+	    ]
+	]
+]
+!!
+methodCategoryRename
+"launch an enterBox to rename current method category"
+|box|
+self checkMethodCategorySelected ifFalse:[^ self].
+box := self enterBoxTitle:(resources string:'rename method category %1 to:' with:currentMethodCategory)
+		okText:(resources at:'rename').
+box initialText:currentMethodCategory.
+box action:[:aString |
+	actualClass renameCategory:currentMethodCategory to:aString.
+	currentMethodCategory := aString.
+	currentMethod := currentSelector := nil.
+	self updateMethodCategoryList.
+	self updateMethodListWithScroll:false
+].
+box showAtPointer
+!!
+methodCategorySpawn
+"create a new SystemBrowser browsing current method category"
+currentMethodCategory notNil ifTrue:[
+	self withWaitCursorDo:[
+	    SystemBrowser 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 |
+					SystemBrowser browseMethodCategory:aString
+				    ]
+!! !!
+!!BrowserView methodsFor:'method category stuff'!!
+checkMethodCategorySelected
+currentMethodCategory isNil ifTrue:[
+	self warn:'select a method category first'.
+	^ false
+].
+^ true
+!!
+copyMethodsFromClass:aClassName
+|class box|
+currentClass notNil ifTrue:[
+	class := Smalltalk classNamed:aClassName.
+	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
+currentClass notNil ifTrue:[
+	Object abortSignal catch:[
+	    class methodArray do:[:aMethod |
+		|source|
+		(category match:aMethod category) ifTrue:[
+		    source := aMethod source.
+		    codeView contents:source.
+		    codeView modified:false.
+		    actualClass compilerClass
+			 compile:source
+			 forClass:actualClass
+			 inCategory:aMethod category
+			 notifying:codeView.
+		    self updateMethodCategoryListWithScroll:false.
+		    self updateMethodListWithScroll:false.
+		]
+	    ]
+	]
+]
+!!
+listOfAllMethodCategoriesInClass:aClass
+"answer a list of all method categories of the argument, aClass"
+|newList|
+newList := Set new.
+aClass methodArray do:[:aMethod |
+	|cat|
+	cat := aMethod category.
+	cat isNil ifTrue:[
+	    cat := '* no category *'
+	].
+	newList add:cat
+].
+(newList size == 0) ifTrue:[^ nil].
+newList add:'* all *'.
+^ newList asOrderedCollection sort
+!!
+listOfAllMethodCategoriesInFullProtocolHierarchy:aClass
+"answer a list of all method categories of the argument, aClass,
+and all of its superclasses.
+Used with fullProtocol browsing."
+|newList|
+newList := Set new.
+self classesInFullProtocolHierarchy:aClass do:[:c |
+	|cat|
+	c methodArray do:[:aMethod |
+	    cat := aMethod category.
+	    cat isNil ifTrue:[
+		cat := '* no category *'
+	    ].
+	    newList add:cat
+	]
+].
+(newList size == 0) ifTrue:[^ nil].
+newList add:'* all *'.
+^ newList asOrderedCollection 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.
+aspect := nil.
+"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 hasSelection ifTrue:[
+"/              self methodSelection:methodListView selection.
+"/          ]
+"/      ]
+]
+"Created: 23.11.1995 / 14:19:56 / cg"
+!!
+methodCategorySelectionChanged
+"method category selection has changed - update dependent views"
+self withWaitCursorDo:[
+	currentMethod := currentSelector := nil.
+	self updateMethodList.
+	self updateCodeView.
+	currentMethodCategory notNil ifTrue:[
+	    methodCategoryListView selectElement:currentMethodCategory
+	].
+	self setAcceptAndExplainActionsForMethod.
+	self hilightMethodsInMethodCategoryList:false inMethodList:true.
+]
+"Created: 23.11.1995 / 14:17:38 / cg"
+"Modified: 23.11.1995 / 14:19:49 / cg"
+!!
+newMethodCategory:aString
+|categories|
+currentClass isNil ifTrue:[
+	^ self warn:'select/create a class first'.
+].
+categories := methodCategoryListView list.
+categories isNil ifTrue:[categories := OrderedCollection new].
+(categories includes:aString) ifFalse:[
+	categories add:aString.
+	categories sort.
+	methodCategoryListView contents:categories
+].
+currentMethodCategory := aString.
+self methodCategorySelectionChanged
+!!
+updateMethodCategoryList
+self updateMethodCategoryListWithScroll:true
+!!
+updateMethodCategoryListWithScroll:scroll
+|categories|
+methodCategoryListView notNil ifTrue:[
+	fullProtocol ifTrue:[
+	    currentClassHierarchy notNil ifTrue:[
+		categories := self listOfAllMethodCategoriesInFullProtocolHierarchy:actualClass
+	    ]
+	] 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
+	    ]
+	]
+]
+!!
+whenMethodCategorySelected:aBlock
+self checkMethodCategorySelected ifTrue:[
+	self withWaitCursorDo:aBlock
+]
+!! !!
+!!BrowserView methodsFor:'method list menu'!!
+commonTraceHelperWith:aSelector
+currentMethod := MessageTracer perform:aSelector with:currentMethod.
+self updateMethodListWithScroll:false keepSelection:true.
+currentClass changed:#methodDictionary with:currentSelector.
+!!
+methodAproposSearch
+"launch an enterBox for a keyword search"
+self askForSelectorTitle:'keyword to search for:'
+		    openWith:#aproposSearch:
+!!
+methodBreakPoint
+"set a breakpoint on the current method"
+currentSelector notNil ifTrue:[
+	currentMethod := actualClass compiledMethodAt:currentSelector.
+	currentMethod isWrapped ifFalse:[
+	    (currentMethod notNil and:[currentMethod isWrapped not]) ifTrue:[
+		self commonTraceHelperWith:#trapMethod:
+	    ]
+	].
+]
+!!
+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].
+actualClass isNil ifTrue:[
+	box := self enterBoxTitle:'' okText:'change'.
+] ifFalse:[
+	|someCategories|
+	someCategories := actualClass categories sort.
+	box := self listBoxTitle:'' okText:'change' list:someCategories.
+].
+box title:('change category from ''' , currentMethod category , ''' to:').
+lastMethodCategory isNil ifTrue:[
+	txt := currentMethod category.
+] ifFalse:[
+	txt := lastMethodCategory
+].
+box initialText:txt.
+box action:[:aString |
+		    lastMethodCategory := aString.
+		    currentMethod category:aString asSymbol.
+		    actualClass changed.
+		    currentMethod changed:#category.
+		    actualClass updateRevisionString.
+		    actualClass addChangeRecordForMethodCategory:currentMethod category:aString.
+		    self updateMethodCategoryListWithScroll:false.
+		    self updateMethodListWithScroll:false
+	       ].
+box showAtPointer
+"Created: 29.10.1995 / 19:59:22 / cg"
+!!
+methodDecompile
+"decompile the current methods bytecodes.
+The Decompiler is delivered as an extra, and not normally
+avaliable with the system."
+self checkMethodSelected ifFalse:[^ self].
+Decompiler notNil ifTrue:[
+	Autoload autoloadFailedSignal handle:[:ex |
+	    ex return
+	] do:[
+	    Decompiler autoload.
+	].
+].
+Decompiler isLoaded ifFalse:[
+	Smalltalk
+	    fileIn:'/phys/clam/claus/work/libcomp/not_delivered/Decomp.st'
+	    logged:false.
+].
+Decompiler isLoaded ifFalse:[
+	^ self warn:'No decompiler available'.
+].
+Decompiler decompile:currentMethod.
+!!
+methodFileOut
+"file out the current method"
+self checkMethodSelected ifFalse:[^ self].
+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.
+!!
+methodGlobalReferends
+"launch an enterBox for global symbol to search for"
+self enterBoxForBrowseTitle:'global variable to browse users of:'
+			 action:[:aString |
+				    SystemBrowser browseReferendsOf:aString asSymbol
+				]
+!!
+methodImplementors
+"launch an enterBox for selector to search for"
+self askForSelectorTitle:'selector to browse implementors of:'
+		    openWith:#browseImplementorsOf:
+!!
+methodInspect
+"inspect  the current method"
+self checkMethodSelected ifFalse:[^ self].
+(actualClass compiledMethodAt:currentSelector) inspect.
+!!
+methodLocalAproposSearch
+"launch an enterBox for a local keyword search"
+self askForSelectorTitle:'keyword to search for:'
+		    openWith:#aproposSearch:in:
+			 and:(currentClass withAllSubclasses)
+!!
+methodLocalImplementors
+"launch an enterBox for selector to search for"
+self checkClassSelected ifFalse:[^ self].
+self askForSelectorTitle:'selector to browse local implementors of:'
+		    openWith:#browseImplementorsOf:under:
+			 and:currentClass
+!!
+methodLocalSenders
+"launch an enterBox for selector to search for in current class & subclasses"
+self checkClassSelected ifFalse:[^ self].
+self askForSelectorTitle:'selector to browse local senders of:'
+		    openWith:#browseCallsOn:under:
+			 and:currentClass
+!!
+methodLocalStringSearch
+"launch an enterBox for string to search for"
+self checkClassSelected ifFalse:[^ self].
+self askForSelectorTitle:'string to search for in local methods:'
+		    openWith:#browseForString:in:
+			 and:(currentClass withAllSubclasses)
+!!
+methodLocalSuperSends
+"launch a browser showing super sends in current class & subclasses"
+self checkClassSelected ifFalse:[^ self].
+self withSearchCursorDo:[
+	SystemBrowser browseSuperCallsUnder:currentClass
+]
+"Created: 23.11.1995 / 12:03:57 / cg"
+"Modified: 23.11.1995 / 14:12:15 / cg"
+!!
+methodMakePrivate
+"make the current method private.
+EXPERIMENTAL"
+self methodPrivacy:#private
+!!
+methodMakeProtected
+"make the current method protected.
+EXPERIMENTAL"
+self methodPrivacy:#protected
+!!
+methodMakePublic
+"make the current method public.
+EXPERIMENTAL"
+self methodPrivacy:#public
+!!
+methodMenu
+"return a popupmenu as appropriate for the methodList"
+|m labels selectors
+newLabels newSelectors
+mthdLabels mthdSelectors
+brkLabels brkSelectors
+fileLabels fileSelectors
+searchLabels searchSelectors
+sepLocalLabels sepLocalSelectors
+localSearchLabels localSearchSelectors|
+device ctrlDown ifTrue:[
+	"/ 'secret' developpers menu
+	currentMethod isNil ifTrue:[
+	    methodListView flash.
+	    ^ nil
+	].
+	labels := #(
+			'inspect method'
+			'compile to machine code'
+			'decompile'
+			'-'
+			'make private'
+			'make protected'
+			'make public'
+		   ).
+	selectors := #(
+			methodInspect
+			methodSTCCompile
+			methodDecompile
+			nil
+			methodMakePrivate
+			methodMakeProtected
+			methodMakePublic
+		      )
+] ifFalse:[
+	sepLocalLabels := sepLocalSelectors := #().
+	searchLabels := #(
+				    'senders ...'
+				    'implementors ...'
+				    'globals ...'
+				    'string search ...'
+				    'apropos ...'
+			).
+	searchSelectors := #(
+				    methodSenders
+				    methodImplementors
+				    methodGlobalReferends
+				    methodStringSearch
+				    methodAproposSearch
+			    ).
+	currentClass notNil ifTrue:[
+	    localSearchLabels := #(
+				    '-'
+				    'local senders ...'
+				    'local implementors ...'
+				    'local super sends ...'
+				    'local string search ...'
+				    'local apropos ...'
+				).
+	    localSearchSelectors := #(
+				    nil
+				    methodLocalSenders
+				    methodLocalImplementors
+				    methodLocalSuperSends
+				    methodLocalStringSearch
+				    methodLocalAproposSearch
+				  ).
+	] ifFalse:[
+	    localSearchLabels := localSearchSelectors := #()
+	].
+	currentMethodCategory notNil ifTrue:[
+	    sepLocalLabels := #('-'). sepLocalSelectors := #(nil).
+	    newLabels :=           #(
+				    'new method'
+				    ).
+	    newSelectors :=    #(
+				    methodNewMethod
+				 ).
+	] ifFalse:[
+	    newLabels := newSelectors := #()
+	].
+	currentMethod notNil ifTrue:[
+	    fileLabels :=           #(
+				    'fileOut'
+				    'printOut'
+				    '-'
+				    'SPAWN_METHOD'
+				    '-'
+				    ).
+	    fileSelectors :=    #(
+				    methodFileOut
+				    methodPrintOut
+				    nil
+				    methodSpawn
+				    nil
+				 ).
+	    sepLocalLabels := #('-'). sepLocalSelectors := #(nil).
+	    mthdLabels :=           #(
+				    'change category ...'
+				    'remove'
+				    ).
+	    mthdSelectors :=    #(
+				    methodChangeCategory
+				    methodRemove
+				 ).
+	    currentMethod isWrapped ifTrue:[
+		brkLabels := #(
+				    'remove break/trace'
+				    '-'
+			      ).
+		brkSelectors := #(
+				    methodRemoveBreakOrTrace
+				    nil
+				 )
+	    ] ifFalse:[
+		brkLabels := #(
+				    'breakpoint'
+				    'trace'
+				    'trace sender'
+				    '-'
+			      ).
+		brkSelectors := #(
+				    methodBreakPoint
+				    methodTrace
+				    methodTraceSender
+				    nil
+				 )
+	    ]
+	] ifFalse:[
+	    fileLabels := fileSelectors := #().
+	    brkLabels := brkSelectors := #().
+	    mthdLabels := mthdSelectors := #().
+	].
+	labels :=
+		    fileLabels ,
+		    searchLabels ,
+		    localSearchLabels ,
+		    sepLocalLabels ,
+		    brkLabels ,
+		    newLabels ,
+		    mthdLabels.
+	selectors :=
+		    fileSelectors ,
+		    searchSelectors ,
+		    localSearchSelectors ,
+		    sepLocalSelectors ,
+		    brkSelectors ,
+		    newSelectors ,
+		    mthdSelectors.
+"
+	labels := #(
+				    'fileOut'
+				    'printOut'
+				    '-'
+				    'SPAWN_METHOD'
+				    '-'
+				    'senders ...'
+				    'implementors ...'
+				    'globals ...'
+				    'string search ...'
+				    'apropos ...'
+				    '-'
+				    'local senders ...'
+				    'local implementors ...'
+				    'local string search ...'
+				    'local apropos ...'
+				    '-'
+				    'breakpoint'
+				    'trace'
+				    'trace sender'
+				    '-'
+				    'new method'
+				    'change category ...'
+				    'remove'
+				).
+	 selectors := #(
+				    methodFileOut
+				    methodPrintOut
+				    nil
+				    methodSpawn
+				    nil
+				    methodSenders
+				    methodImplementors
+				    methodGlobalReferends
+				    methodStringSearch
+				    methodAproposSearch
+				    nil
+				    methodLocalSenders
+				    methodLocalImplementors
+				    methodLocalStringSearch
+				    methodLocalAproposSearch
+				    nil
+				    methodBreakPoint
+				    methodTrace
+				    methodTraceSender
+				    nil
+				    methodNewMethod
+				    methodChangeCategory
+				    methodRemove
+				  )
+"
+].
+m := PopUpMenu
+	 labels:(resources array:labels)
+	 selectors:selectors.
+currentMethod notNil ifTrue:[
+	currentMethod isPrivate ifTrue:[
+	    m disable:#methodMakePrivate
+	].
+	currentMethod isProtected ifTrue:[
+	    m disable:#methodMakeProtected
+	].
+	currentMethod isPublic ifTrue:[
+	    m disable:#methodMakePublic
+	].
+].
+currentMethod notNil ifTrue:[
+	(currentMethod code notNil
+	or:[Compiler canCreateMachineCode not]) ifTrue:[
+	    m disable:#methodSTCCompile
+	].
+	currentMethod byteCode isNil ifTrue:[
+	    m disable:#methodDecompile
+	].
+].
+^ m
+"Created: 23.11.1995 / 12:02:29 / cg"
+!!
+methodNewMethod
+"prepare for definition of a new method - put a template into
+code view and define accept-action to compile it"
+currentClass isNil ifTrue:[
+	^ self warn:'select/create a class first'.
+].
+currentMethodCategory isNil ifTrue:[
+	^ self warn:'select/create a method category first'.
+].
+currentMethod := currentSelector := nil.
+methodListView deselect.
+codeView contents:(self template).
+codeView modified:false.
+self setAcceptAndExplainActionsForMethod.
+!!
+methodPrintOut
+"print out the current method"
+|printStream|
+self checkMethodSelected ifFalse:[^ self].
+printStream := Printer new.
+actualClass printOutSource:(currentMethod source) on:printStream.
+printStream close
+!!
+methodPrivacy:how
+"change the current methods privacy.
+EXPERIMENTAL"
+self checkMethodSelected ifFalse:[^ self].
+currentMethod isPublic ifFalse:[
+	currentMethod privacy:how.
+	actualClass updateRevisionString.
+	actualClass addChangeRecordForMethodPrivacy:currentMethod.
+	self updateMethodListWithScroll:false keepSelection:true.
+]
+"Created: 29.10.1995 / 20:00:00 / cg"
+!!
+methodRemove
+"remove the current method"
+self checkMethodSelected ifFalse:[^ self].
+actualClass removeSelector:(actualClass selectorAtMethod:currentMethod).
+currentMethod := currentSelector := nil.
+self updateMethodListWithScroll:false
+!!
+methodRemoveBreakOrTrace
+"turn off tracing of the current method"
+(currentMethod notNil and:[currentMethod isWrapped]) ifTrue:[
+	self commonTraceHelperWith:#unwrapMethod:
+]
+!!
+methodSTCCompile
+"compile the current method to machine code.
+This is not supported on all machines, and never supported in
+the demo version."
+|prev|
+self checkMethodSelected ifFalse:[^ self].
+prev := Compiler stcCompilation:#always.
+[
+	codeView accept.
+] valueNowOrOnUnwindDo:[
+	Compiler stcCompilation:prev
+].
+!!
+methodSenders
+"launch an enterBox for selector to search for"
+self askForSelectorTitle:'selector to browse senders of:'
+		    openWith:#browseAllCallsOn:
+!!
+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 isMeta w|
+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:[
+			    SystemBrowser 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.
+	SystemBrowser browseClass:(w at:1) selector:(w at:2)
+]
+!!
+methodStringSearch
+"launch an enterBox for string to search for"
+self askForSelectorTitle:'string to search for in sources:'
+		    openWith:#browseForString:
+!!
+methodTrace
+"turn on tracing of the current method"
+currentClass notNil ifTrue:[
+currentSelector notNil ifTrue:[
+	  currentMethod := actualClass compiledMethodAt:currentSelector
+]
+].
+(currentMethod notNil and:[currentMethod isWrapped not]) ifTrue:[
+	self commonTraceHelperWith:#traceMethod:
+]
+!!
+methodTraceSender
+"turn on tracing of the current method"
+(currentMethod notNil and:[currentMethod isWrapped not]) ifTrue:[
+	self commonTraceHelperWith:#traceMethodSender:
+]
+!! !!
+!!BrowserView methodsFor:'method stuff'!!
+checkMethodSelected
+currentMethod isNil ifTrue:[
+	self warn:'select a method first'.
+	^ false
+].
+^ true
+!!
+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|
+newList := Set new.
+self classesInFullProtocolHierarchy:aClass do:[:c |
+	|searchCategory|
+	(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
+!!
+listOfAllSelectorsInCategory:aCategory ofClass:aClass
+"answer a list of all selectors in a given method category
+of the argument, aClass"
+|newList searchCategory all p|
+all := (aCategory = '* all *').
+(aCategory = '* no category *') ifTrue:[
+	searchCategory := nil
+] ifFalse:[
+	searchCategory := aCategory
+].
+newList := OrderedCollection new.
+aClass methodArray with:aClass selectorArray do:[:aMethod :selector |
+	|sel how|
+	(all or:[aMethod category = searchCategory]) ifTrue:[
+	    sel := selector.
+	    (p := aMethod privacy) ~~ #public ifTrue:[
+		how := '    (* ' , p , ' *)'.
+	    ].
+	    aMethod isWrapped ifTrue:[
+		how := ' !!!!'
+	    ].
+	    aMethod isInvalid ifTrue:[
+		how := '    (** not executable **)'
+	    ].
+	    aMethod isLazyMethod ifTrue:[
+"/                how := '    (lazy)'
+	    ] ifFalse:[
+		(aMethod code isNil
+		and:[aMethod byteCode isNil]) ifTrue:[
+		    how := '    (** unloaded **)'
+		]
+	    ].
+	    how notNil ifTrue:[sel := sel , how].
+	    newList add:sel
+	]
+].
+(newList size == 0) ifTrue:[^ nil].
+^ newList sort
+"Modified: 28.8.1995 / 21:53:34 / claus"
+!!
+methodSelection:lineNr
+"user clicked on a method line - show code"
+|selectorString selectorSymbol|
+(fullProtocol not and:[currentClass isNil]) ifTrue:[^ self].
+selectorString := methodListView selectionValue.
+"
+kludge: extract real selector
+"
+selectorString := selectorString withoutSpaces upTo:(Character space).
+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.
+		acceptClass := c
+	    ]
+	]
+] 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
+!!
+methodSelectionChanged
+"method selection has changed - update dependent views"
+self withWaitCursorDo:[
+	|index cls|
+	self updateCodeView.
+	aspect := nil.
+	self setAcceptAndExplainActionsForMethod.
+	"
+	 if there is any autoSearch string, do the search
+	"
+	autoSearch notNil ifTrue:[
+	    codeView searchFwd:autoSearch startingAtLine:1 col:0 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
+		 and:[cls isMeta
+		 and:[cls name endsWith:'class']]) ifTrue:[
+		    index := classListView list indexOf:(cls name copyWithoutLast:5).
+		].
+		index ~~ 0 ifTrue:[
+		    classListView attributeAt:index add:#bold.
+		].
+		currentClass := acceptClass := cls.
+	    ]
+	].
+]
+"Created: 23.11.1995 / 14:17:44 / cg"
+!!
+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 whichClassIncludesSelector:aSelector.
+	aClass notNil ifTrue:[
+	    nm := aClass name.
+	    showInstance ifFalse:[
+		((nm ~= 'Metaclass') and:[nm endsWith:'class']) ifTrue:[
+		    nm := nm copyWithoutLast:5 "copyTo:(nm size - 5)"
+		]
+	    ].
+	    self switchToClassNamed:nm.
+	    self switchToMethodNamed:aString
+	]
+]
+!!
+switchToMethodNamed:matchString
+"switch (in the current class) to a method named matchString.
+If there are more than one matches, switch to the first."
+|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 updateMethodCategoryListWithScroll:false.
+	    self methodCategorySelectionChanged.
+	    currentMethod := classToSearch compiledMethodAt:aSelector.
+	    currentMethod notNil ifTrue:[
+		currentSelector := aSelector.
+		methodListView selectElement:aSelector.
+	    ].
+	    self methodSelectionChanged
+	]
+]
+!!
+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''.
+"
+'
+!!
+updateMethodList
+self updateMethodListWithScroll:true keepSelection:false
+!!
+updateMethodListWithScroll:scroll
+self updateMethodListWithScroll:scroll keepSelection:false
+!!
+updateMethodListWithScroll:scroll keepSelection:keep
+|selectors scr first last selection|
+methodListView notNil ifTrue:[
+	selection := methodListView selection.
+	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
+	    ]
+	].
+	keep ifTrue:[
+	    methodListView selection:selection.
+	]
+]
+!! !!
+!!BrowserView methodsFor:'misc'!!
+instanceProtocol:aBoolean
+"switch between instance and class protocol"
+|onToggle offToggle|
+showInstance ~~ aBoolean ifTrue:[
+	self checkSelectionChangeAllowed ifTrue:[
+	    instanceToggle notNil ifTrue:[
+		aBoolean ifTrue:[
+		    offToggle := classToggle.
+		    onToggle := instanceToggle.
+		] ifFalse:[
+		    onToggle := classToggle.
+		    offToggle := instanceToggle.
+		].
+		onToggle turnOn.
+		offToggle turnOff.
+	    ].
+	    showInstance := aBoolean.
+	    (variableListView notNil
+	    and:[variableListView hasSelection]) ifTrue:[
+		self unhilightMethodCategories.
+		self unhilightMethods.
+		variableListView deselect
+	    ].
+	    fullProtocol ifTrue:[
+		showInstance ifTrue:[
+		    actualClass := currentClassHierarchy.
+		] ifFalse:[
+		    actualClass := currentClassHierarchy class.
+		].
+		acceptClass := actualClass.
+		self updateClassList.
+		self updateMethodCategoryListWithScroll:false.
+		self updateMethodListWithScroll:false.
+		self updateVariableList.
+		^ self
+	    ].
+	    currentClass notNil ifTrue:[
+		self classSelectionChanged
+	    ].
+	    codeView modified:false.
+	] ifFalse:[
+	    aBoolean ifTrue:[
+		onToggle := classToggle.
+		offToggle := instanceToggle
+	    ] ifFalse:[
+		offToggle := classToggle.
+		onToggle := instanceToggle.
+	    ].
+	    onToggle turnOn.
+	    offToggle turnOff.
+	]
+]
+!!
+processName
+"the name of my process - for the processMonitor only"
+^ 'System Browser'.
+!!
+updateCodeView
+|code|
+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.
+"Created: 23.11.1995 / 14:16:43 / cg"
+"Modified: 23.11.1995 / 14:19:25 / cg"
+!! !!
+!!BrowserView methodsFor:'private'!!
+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
+!!
+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
+!!
+askForSelectorTitle:title
+"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 | aString isEmpty ifTrue:[^ nil]. ^ aString].
+box showAtPointer.
+^ nil
+!!
+askForSelectorTitle:title openWith:selector
+"convenient method: setup enterBox with text from codeView or selected
+method for browsing based on a selector. Set action and launch box"
+|string|
+string := self askForSelectorTitle:title.
+string notNil ifTrue:[
+	self withSearchCursorDo:[
+	    SystemBrowser perform:selector with:string
+	]
+].
+"Created: 23.11.1995 / 14:11:34 / cg"
+!!
+askForSelectorTitle:title openWith:selector and:arg
+"convenient method: setup enterBox with text from codeView or selected
+method for browsing based on a selector. Set action and launch box"
+|string|
+string := self askForSelectorTitle:title.
+string notNil ifTrue:[
+	self withSearchCursorDo:[
+	    SystemBrowser perform:selector with:string with:arg
+	]
+].
+"Created: 23.11.1995 / 14:11:38 / cg"
+!!
+busyLabel:what with:someArgument
+"set the title for some warning"
+self label:('System Browser - ' , (resources string:what with:someArgument))
+!!
+checkSelectionChangeAllowedWithCompare:compareOffered
+"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"
+|action labels values|
+codeView modified ifFalse:[
+	^ true
+].
+compareOffered ifTrue:[
+	labels := #('abort' 'compare' 'accept' 'continue').
+	values := #(false #compare #accept true).
+] ifFalse:[
+	labels := #('abort' 'accept' 'continue').
+	values := #(false #accept true).
+].
+action := OptionBox
+		  request:(resources at:'text has not been accepted.\\Your modifications will be lost when continuing.') withCRs
+		  label:(resources string:'Attention')
+		  form:(WarningBox iconBitmap)
+		  buttonLabels:(resources array:labels)
+		  values:values
+		  default:true.
+action ~~ #accept ifTrue:[
+	^ action
+].
+codeView accept.
+^ true
+"Created: 24.11.1995 / 10:54:46 / cg"
+!!
+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"
+|what m src v|
+currentMethod notNil ifTrue:[
+	m := actualClass compiledMethodAt:currentSelector.
+	m notNil ifTrue:[
+	    (src := m source) = codeView contents ifFalse:[
+		what := self checkSelectionChangeAllowedWithCompare:true.
+		what == #compare ifTrue:[
+		    v := DiffTextView
+			    openOn:codeView contents label:'code here (to be accepted ?)'
+			    and:src label:'methods actual code'.
+		    v label:'comparing method versions'.
+		    ^ false
+		].
+		^ what
+	    ]
+	]
+].
+^ self checkSelectionChangeAllowedWithCompare:false
+"Created: 24.11.1995 / 11:03:33 / cg"
+"Modified: 24.11.1995 / 11:05:49 / cg"
+!!
+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
+	]
+]
+!!
+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
+]
+!!
+classesInHierarchy:aClass do:aBlock
+|index|
+index := (classListView list size).
+aClass withAllSuperclasses do:[:c |
+	(classListView isInSelection:index) ifFalse:[
+	    aBlock value:c
+	].
+	index := index - 1
+]
+!!
+compileCode:someCode
+(ReadStream on:someCode) fileIn
+!!
+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 |
+	aString notEmpty ifTrue:[
+	    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
+!!
+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
+!!
+enterBoxTitle:title okText:okText
+"convenient method: setup enterBox"
+|box|
+box := EnterBox new.
+box title:(resources string:title) okText:(resources string:okText).
+^ box
+!!
+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 copyWithoutLast:5 "copyTo:(clsName size - 5)"
+	    ] ifFalse:[
+		isMeta := false
+	    ].
+	]
+].
+aBlock value:clsName value:sel value:isMeta
+!!
+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
+!!
+listBoxForCodeSelectionTitle:title okText:okText
+"convenient method: setup listBox with text from codeview"
+|sel box|
+box := self listBoxTitle:title okText:okText list:nil.
+sel := codeView selection.
+sel notNil ifTrue:[
+	box initialText:(sel asString withoutSeparators)
+].
+^ box
+!!
+listBoxTitle:title okText:okText list:aList
+"convenient method: setup a listBox & return it"
+|box|
+box := ListSelectionBox
+		title:(resources string:title)
+		okText:(resources string:okText)
+		action:nil.
+box list:aList.
+^ box
+!!
+normalLabel
+"set the normal (inactive) window- and icon labels"
+|l il|
+myLabel notNil ifTrue:[
+	"if I have been given an explicit label,
+	 and its not the default, take that one"
+	myLabel ~= 'System Browser' ifTrue:[
+	    l := il := myLabel
+	]
+].
+l isNil ifTrue:[
+	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.
+!!
+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 upTo:(Character space)
+	] ifFalse:[
+	    sel := ''
+	]
+].
+^ sel
+!!
+setAcceptAndExplainActionsForMethod
+"tell the codeView what to do on accept and explain"
+codeView acceptAction:[:theCode |
+	|cat cls|
+	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:[
+	    fullProtocol ifTrue:[
+		cls := acceptClass "/actualClass whichClassIncludesSelector:currentSelector.
+	    ].
+	    cls isNil ifTrue:[
+		cls := actualClass
+	    ].
+	    Object abortSignal catch:[
+		lockUpdates := true.
+		actualClass compilerClass
+		    compile:theCode asString
+		    forClass:cls
+		    inCategory:cat
+		    notifying:codeView.
+		codeView modified:false.
+		self updateMethodListWithScroll:false.
+		currentMethod := actualClass compiledMethodAt:currentSelector.
+	    ].
+	    lockUpdates := false.
+	].
+	codeView cursor:Cursor normal.
+].
+codeView explainAction:[:theCode :theSelection |
+	self showExplanation:(Explainer
+				explain:theSelection
+				in:theCode
+				forClass:actualClass)
+].
+!!
+setDoitActionForClass
+"tell the codeView what to do on doIt"
+"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 evaluatorClass
+	].
+	compiler
+	    evaluate:theCode
+	    in:nil
+	    receiver:currentClass
+	    notifying:codeView
+	    logged:false
+	    ifFail:nil
+].
+!!
+setSearchPattern:aString
+codeView setSearchPattern:aString
+!!
+showExplanation:someText
+"show explanation from Parser"
+self information: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
+!!
+warnLabel:what
+"set the title for some warning"
+self label:('System Browser WARNING: ' , what)
+!!
+withSearchCursorDo:aBlock
+^ self withCursor:(Cursor questionMark) do:aBlock
+"Created: 23.11.1995 / 14:11:14 / cg"
+!! !!
+!!BrowserView methodsFor:'unused'!!
+listOfAllMethodCategoriesInHierarchy:aClass
+"answer a list of all method categories of the argument, aClass,
+and all of its superclasses"
+|newList cat|
+newList := Set new.
+self classesInHierarchy:aClass do:[:c |
+	c methodArray do:[:aMethod |
+	    cat := aMethod category.
+	    cat isNil ifTrue:[
+		cat := '* no category *'
+	    ].
+	    newList add:cat
+	]
+].
+(newList size == 0) ifTrue:[^ nil].
+newList add:'* all *'.
+^ newList asOrderedCollection sort
+!!
+listOfAllSelectorsInCategory:aCategory inHierarchyOfClass:aClass
+"answer a list of all selectors in a given method category
+of the argument, aClass and its superclasses"
+|newList|
+newList := Set new.
+self classesInHierarchy:aClass do:[:c |
+	|searchCategory|
+	(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
+!! !!
+!!BrowserView methodsFor:'variable list menu'!!
+allClassOrInstVarRefsTitle:title access:access mods:modifications
+"show an enterbox for instVar to search for"
+self doClassMenu:[:currentClass |
+	|box|
+	box := self enterBoxForVariableSearch:title.
+	box action:[:aVariableName |
+	    |homeClass|
+	    aVariableName isEmpty ifFalse:[
+		self withSearchCursorDo:[
+		    homeClass := self findClassOfVariable:aVariableName accessWith:access.
+		    access == #classVarNames ifTrue:[
+			SystemBrowser
+			    browseClassRefsTo:aVariableName
+			    under:homeClass
+			    modificationsOnly:modifications
+		    ] ifFalse:[
+			SystemBrowser
+			    browseInstRefsTo:aVariableName
+			    under:homeClass
+			    modificationsOnly:modifications
+		    ]
+		]
+	    ]
+	].
+	box showAtPointer
+]
+"Created: 23.11.1995 / 14:13:24 / cg"
+!!
+allClassVarMods
+"show an enterbox for classVar to search for"
+self allClassOrInstVarRefsTitle:'class variable to browse modifications of:'
+				  access:#classVarNames
+				  mods:true
+!!
+allClassVarRefs
+"show an enterbox for classVar to search for"
+self allClassOrInstVarRefsTitle:'class variable to browse references to:'
+				  access:#classVarNames
+				  mods:false
+!!
+allInstVarMods
+"show an enterbox for instVar to search for"
+self allClassOrInstVarRefsTitle:'instance variable to browse modifications of:'
+				  access:#instVarNames
+				  mods:true
+!!
+allInstVarRefs
+"show an enterbox for instVar to search for"
+self allClassOrInstVarRefsTitle:'instance variable to browse references to:'
+				  access:#instVarNames
+				  mods:false
+!!
+classVarMods
+"show an enterbox for classVar to search for"
+self classVarRefsOrModsTitle:'class variable to browse modifications of:'
+				 mods:true
+!!
+classVarRefs
+"show an enterbox for classVar to search for"
+self classVarRefsOrModsTitle:'class variable to browse references to:'
+				 mods:false
+!!
+classVarRefsOrModsTitle:title mods:mods
+"show an enterbox for classVar to search for"
+self doClassMenu:[:currentClass |
+	|box|
+	box := self enterBoxForVariableSearch:title.
+	box action:[:aString |
+	    aString notEmpty ifTrue:[
+		self withSearchCursorDo:[
+		    SystemBrowser
+			   browseClassRefsTo:aString
+			   in:(Array with:currentClass)
+			   modificationsOnly:mods
+		]
+	    ]
+	].
+	box showAtPointer
+]
+"Created: 23.11.1995 / 14:12:56 / cg"
+!!
+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
+!!
+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
+!!
+instVarRefsOrModsTitle:title mods:mods
+"show an enterbox for instvar to search for"
+self doClassMenu:[:currentClass |
+	|box|
+	box := self enterBoxForVariableSearch:title.
+	box action:[:aString |
+	    aString notEmpty ifTrue:[
+		self withSearchCursorDo:[
+		    SystemBrowser
+			browseInstRefsTo:aString
+			in:(Array with:currentClass)
+			modificationsOnly:mods
+		]
+	    ]
+	].
+	box showAtPointer
+]
+"Created: 23.11.1995 / 14:12:40 / cg"
+!!
+varTypeInfo
+"show typical usage of a variable"
+|name idx classes values value msg cut names instCount subInstCount box
+searchClass|
+name := variableListView selectionValue.
+name isNil ifTrue:[^ self].
+searchClass := actualClass whichClassDefinesInstVar:name.
+idx := searchClass instVarOffsetOf:name.
+idx isNil ifTrue:[^ self].
+classes := IdentitySet new.
+values := IdentitySet new.
+instCount := 0.
+subInstCount := 0.
+searchClass allSubInstancesDo:[:i |
+	|val|
+	val := i instVarAt:idx.
+	val notNil ifTrue:[values add:val].
+	classes add:val class.
+	(i isMemberOf:searchClass) ifTrue:[
+	    instCount := instCount + 1.
+	] ifFalse:[
+	    subInstCount := subInstCount + 1
+	]
+].
+(instCount == 0 and:[subInstCount == 0]) ifTrue:[
+	self warn:'there are currently no instances of ' , currentClass name.
+	^ self
+].
+instCount ~~ 0 ifTrue:[
+	msg := 'in (currently: ' , instCount printString,') instances '.
+	subInstCount ~~ 0 ifTrue:[
+	    msg := msg , 'and '
+	]
+] ifFalse:[
+	msg := 'in '.
+].
+subInstCount ~~ 0 ifTrue:[
+	msg := msg , '(currently: ' , subInstCount printString, ') derived instances '
+].
+msg := msg, 'of ' , searchClass name , ',\'.
+msg := msg , name , ' '.
+((values size == 1)
+or:[classes size == 1 and:[classes first == UndefinedObject]]) ifTrue:[
+	values size == 1 ifTrue:[value := values first].
+	(value isNumber or:[value isString]) ifTrue:[
+	    msg := msg , 'is always the same:\\      ' ,
+			 value class name , ' (' , value storeString , ')'.
+	] ifFalse:[
+	    (value isNil or:[value == true or:[value == false]]) ifTrue:[
+		msg := msg , 'is always:\\      ' ,
+			     value printString.
+	    ] ifFalse:[
+		msg := msg , 'is always the same:\\'.
+		msg := msg , '      ' , value class name.
+		value isLiteral ifTrue:[
+		    msg := msg , ' (' , value storeString , ')'
+		]
+	    ]
+	]
+] ifFalse:[
+	classes size == 1 ifTrue:[
+	    msg := msg , 'is always:\\'.
+	    msg := msg , '      ' , classes first name , '\'.
+	] ifFalse:[
+	    msg := msg , 'is one of:\\'.
+	    classes := classes asOrderedCollection.
+	    classes size > 20 ifTrue:[
+		classes := classes copyFrom:1 to:20.
+		cut := true
+	    ] ifFalse:[
+		cut := false.
+	    ].
+	    names := classes collect:[:cls |
+		|nm|
+		cls == UndefinedObject ifTrue:[
+		    'nil'
+		] ifFalse:[
+		    cls == True ifTrue:[
+			'true'
+		    ] ifFalse:[
+			cls == False ifTrue:[
+			    'false'
+			] ifFalse:[
+			    cls name
+			]
+		    ]
+		].
+	    ].
+	    names sort.
+	    names do:[:nm |
+		msg := msg , '      ' , nm , '\'.
+	    ].
+	]
+].
+box := InfoBox title:msg withCRs.
+box label:'variable type information'.
+box showAtPointer
+!!
+variableListMenu
+|labels selectors|
+currentClass isNil ifTrue:[
+	variableListView flash.
+	^ nil
+].
+labels := #(
+		    '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
+		 ).
+(showInstance and:[variableListView hasSelection]) ifTrue:[
+	labels := labels , #(
+				'-'
+				'type information'
+			   ).
+	selectors := selectors , #(
+				nil
+				varTypeInfo
+				).
+].
+^ PopUpMenu labels:(resources array:labels)
+		selectors:selectors
+!!
+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.
+!! !!
+!!BrowserView methodsFor:'variable stuff'!!
+hilightMethodsInMethodCategoryList
+"search for methods  which access the selected
+variable, and highlight them"
+self hilightMethodsInMethodCategoryList:true inMethodList:false
+!!
+hilightMethodsInMethodCategoryList:inCat inMethodList:inMethods
+"search for methods  which access the selected
+variable, and highlight them"
+|name 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 withSearchCursorDo:[
+	|classes filter any|
+	classes := Array with:actualClass.
+	currentClassHierarchy notNil ifTrue:[
+	    classes := classes , actualClass allSuperclasses.
+	    redefinedSelectors := IdentitySet new.
+	].
+	filter := SystemBrowser filterToSearchRefsTo:name classVars:showInstance not modificationsOnly:false.
+	any := false.
+	"
+	 highlight the method that ref this variable
+	"
+	classes do:[:someClass |
+	    (fullProtocol
+	    and:[classListView valueIsInSelection:(someClass name)]) ifFalse:[
+		someClass methodArray with:someClass selectorArray
+		do:[:method :selector |
+		    (inCat
+		    or:[methodListView list notNil
+			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
+	]
+]
+"Created: 23.11.1995 / 14:12:08 / cg"
+!!
+hilightMethodsInMethodList
+"search for methods  which access the selected
+variable, and highlight them"
+self hilightMethodsInMethodCategoryList:false inMethodList:true
+!!
+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.
+	]
+].
+!!
+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.
+	].
+].
+!!
+updateVariableList
+|l subList last nameAccessSelector class oldSelection|
+variableListView isNil ifTrue:[^ self].
+oldSelection := variableListView selectionValue.
+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 := currentClassHierarchy notNil ifTrue:[currentClassHierarchy] ifFalse:[currentClass].
+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.
+	self hilightMethodsInMethodCategoryList:true inMethodList:true.
+]
+!! !!
+!!BrowserView class methodsFor:'documentation'!!
+version
+^ '$Header: /cvs/stx/stx/libtool/BrowserView.st,v 1.58 1995-12-07 12:26:14 cg Exp $'!! !!
+BrowserView initialize!!
+!
+classPrimitiveVariables
+"show the classes primitiveVariables in the codeView.
+Also, set accept action to change it."
+self classShowFrom:#primitiveVariablesString
+		   set:#primitiveVariables:
+		aspect:#primitiveVariables
+	       default:'%{
+/*
+* any local C variables
+* come here (please, define as static)
+*/
+%}'
+!!
+classPrintOut
+self classPrintOutWith:#printOutOn:
+!!
+classPrintOutFullProtocol
+self classPrintOutWith:#printOutFullProtocolOn:
+!!
+classPrintOutProtocol
+self classPrintOutWith:#printOutProtocolOn:
+!!
+classPrintOutWith:aSelector
+self doClassMenu:[:currentClass |
+	|printStream|
+	printStream := Printer new.
+	currentClass perform:aSelector with:printStream.
+	printStream close
+]
+!!
+classProtocols
+^ self
+!!
+classRefs
+self doClassMenu:[:currentClass |
+	self withSearchCursorDo:[
+	    SystemBrowser browseReferendsOf:currentClass name asSymbol
+	]
+]
+"Created: 23.11.1995 / 14:11:43 / cg"
+!!
+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 %1'.
+	count ~~ 0 ifTrue:[
+	   t := t , '\(with %2 subclass'.
+	   count ~~ 1 ifTrue:[
+		t := t , 'es'
+	   ].
+	   t := (t , ')')
+	].
+	t := t , ' ?'.
+	t := (resources string:t with:currentClass name with:count) 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 |
+		|didRemove|
+		didRemove := false.
+		"
+		 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:[
+			didRemove := true.
+			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
+		].
+"
+		didRemove ifTrue:[
+		    methodCategoryListView notNil ifTrue:[methodCategoryListView contents:nil].
+		    methodListView notNil ifTrue:[methodListView contents:nil].
+		    codeView contents:nil.
+		    codeView modified: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
+!!
+classShowFrom:getSelector set:setSelector aspect:aspectSymbol default:default
+"common helper for comment, primitive-stuff etc.
+show the string returned from the classes getSelector-method,
+Set acceptaction to change it via setSelector."
+self doClassMenu:[:currentClass |
+	|text|
+	text := currentClass perform:getSelector.
+	text isNil ifTrue:[
+	    text := default
+	].
+	codeView contents:text.
+	codeView modified:false.
+	codeView acceptAction:[:theCode |
+	    Object abortSignal catch:[
+		lockUpdates := true.
+		currentClass perform:setSelector with:theCode asString.
+		codeView modified:false.
+	    ].
+	    lockUpdates := false.
+	].
+	codeView explainAction:nil.
+	methodListView notNil ifTrue:[
+	    methodListView deselect
+	].
+	aspect := aspectSymbol.
+	self normalLabel
+]
+!!
+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."
+self doClassMenuWithSelection:[:cls :sel |
+	|browser|
+	cls isMeta ifTrue:[
+	    Smalltalk allBehaviorsDo:[:aClass |
+		aClass class == cls ifTrue:[
+		    browser := SystemBrowser browseClass:aClass.
+		    browser instanceProtocol:false.
+		    sel notNil ifTrue:[
+			browser switchToMethodNamed:sel
+		    ].
+		    ^ self
+		].
+	    ].
+	    self warn:'oops, no class for this metaclass'.
+	    ^ self
+	].
+	browser := SystemBrowser browseClass:cls.
+	cls hasMethods ifFalse:[
+	    browser instanceProtocol:false.
+	].
+	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
+"
+!!
+classSpawnFullProtocol
+"create a new browser, browsing current classes full protocol"
+self doClassMenuWithSelection:[:cls :sel |
+	SystemBrowser browseFullClassProtocol:cls
+]
+!!
+classSpawnHierarchy
+"create a new HierarchyBrowser browsing current class"
+self doClassMenuWithSelection:[:cls :sel |
+	SystemBrowser browseClassHierarchy:cls
+]
+!!
+classSpawnSubclasses
+"create a new browser browsing current class's subclasses"
+self doClassMenuWithSelection:[:cls :sel |
+	|subs|
+	subs := cls allSubclasses.
+	(subs notNil and:[subs size ~~ 0]) ifTrue:[
+	    SystemBrowser browseClasses:subs title:('subclasses of ' , cls name)
+	]
+]
+!!
+classUnload
+"unload an autoloaded class"
+|nm|
+self checkClassSelected ifFalse:[^ self].
+nm := currentClass name.
+currentClass unload.
+self switchToClassNamed:nm
+!!
+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:[:currentClass |
+	self withSearchCursorDo:[
+	    SystemBrowser browseUsesOf:currentClass
+	]
+]
+"Created: 23.11.1995 / 14:11:47 / cg"
+!!
+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|
+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 copyWithoutLast:5 "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:[:currentClass | aBlock value:currentClass value:sel]
+!! !!
+!!BrowserView methodsFor:'class list source administration'!!
+classCreateSourceContainerFor:aClass
+"let user specify the source-repository values for aClass"
+|box
+moduleDirectory subDirectory
+fileName specialFlags
+check y component info fn project|
+moduleDirectory := 'stx' asValue.
+subDirectory := '' asValue.
+(Project notNil and:[(project := Project current) notNil]) ifTrue:[
+	subDirectory value:(project name)
+].
+info := SourceCodeManager sourceInfoOfClass:aClass.
+info notNil ifTrue:[
+	(info includesKey:#module) ifTrue:[
+	    moduleDirectory value:(info at:#module).
+	].
+	(info includesKey:#directory) ifTrue:[
+	    subDirectory value:(info at:#directory).
+	].
+	(info includesKey:#expectedFileName) ifTrue:[
+	    fn := (info at:#expectedFileName).
+	] ifFalse:[
+	    (info includesKey:#classFileName) ifTrue:[
+		fn := (info at:#classFileName).
+	    ]
+	]
+].
+fn isNil ifTrue:[
+	fn := (Smalltalk fileNameForClass:aClass) , '.st'.
+].
+"/
+"/ should check for conflicts ...
+"/
+fileName := fn asValue.
+box := DialogBox new.
+box label:(resources string:'Repository information for %1' with:aClass name).
+component := box addTextLabel:(resources string:'CREATE_REPOSITORY' with:currentClass name) withCRs.
+component adjust:#left; borderWidth:0.
+y := box yPosition.
+component := box addTextLabel:(resources string:'Module:').
+component width:0.5; adjust:#right.
+box yPosition:y.
+component := box addInputFieldOn:moduleDirectory tabable:true.
+component width:0.5; left:0.5; immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine.
+box addVerticalSpace.
+y := box yPosition.
+component := box addTextLabel:'Package:'.
+component width:0.5; adjust:#right.
+box yPosition:y.
+component := box addInputFieldOn:subDirectory tabable:true.
+component width:0.5; left:0.5; immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine.
+box addVerticalSpace.
+y := box yPosition.
+component := box addTextLabel:'Filename:'.
+component width:0.5; adjust:#right.
+box yPosition:y.
+component := box addInputFieldOn:fileName tabable:true.
+component width:0.5; left:0.5; immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine.
+box addVerticalSpace.
+box addVerticalSpace.
+box addAbortButton; addOkButton.
+box showAtPointer.
+box accepted ifTrue:[
+	self halt.
+]
+"Modified: 25.11.1995 / 18:03:25 / cg"
+!!
+classCheckin
+"check a class into the source repository"
+self doClassMenu:[:currentClass |
+	|logMessage info|
+	(info := SourceCodeManager sourceInfoOfClass:currentClass) isNil ifTrue:[
+	    ^ self classCreateSourceContainerFor:currentClass
+	].
+	logMessage := Dialog
+			 request:'enter a log message:'
+			 initialAnswer:lastSourceLogMessage
+			 onCancel:nil.
+	logMessage notNil ifTrue:[
+	    lastSourceLogMessage := logMessage.
+	    self busyLabel:'checking in %1' with:currentClass name.
+	    (SourceCodeManager checkinClass:currentClass logMessage:logMessage) ifFalse:[
+		self warn:'checkin failed'.
+	    ].
+	    aspect == #revisionInfo ifTrue:[
+		self classListUpdate
+	    ].
+	    self normalLabel.
+	]
+]
+"Created: 23.11.1995 / 11:41:38 / cg"
+"Modified: 3.12.1995 / 13:28:30 / cg"
+!!
+classCompareWithNewestInRepository
+"open a diff-textView comparing the current (in-image) version
+with the most recent version found in the repository."
+self doClassMenu:[:currentClass |
+	|aStream comparedSource currentSource v rev revString|
+	rev := Dialog request:'compare to revision: (empty for newest)'.
+	rev notNil ifTrue:[
+	    rev withoutSpaces isEmpty ifTrue:[
+		self busyLabel:'extracting newest %1' with:currentClass name.
+		aStream := SourceCodeManager mostRecentSourceStreamForClassNamed:currentClass name.
+		revString := 'newest'
+	    ] ifFalse:[
+		self busyLabel:'extracting previous %1' with:currentClass name.
+		aStream := SourceCodeManager sourceStreamFor:currentClass revision:rev.
+		revString := rev
+	    ].
+	    comparedSource := aStream contents.
+	    aStream close.
+	    self busyLabel:'generating current source ...' with:nil.
+	    aStream := '' writeStream.
+	    currentClass fileOutOn:aStream withTimeStamp:false.
+	    currentSource := aStream contents.
+	    aStream close.
+	    self busyLabel:'comparing  ...' with:nil.
+	    v := DiffTextView
+		openOn:currentSource label:'current (' , currentClass revision , ')'
+		and:comparedSource label:'repository (' , revString , ')'.
+	    v label:'comparing ' , currentClass name.
+	    self normalLabel.
+	]
+]
+"Created: 14.11.1995 / 16:43:15 / cg"
+"Modified: 22.11.1995 / 22:17:08 / cg"
+!!
+classRevisionInfo
+"show current classes revision info in codeView"
+self doClassMenu:[:currentClass |
+	|aStream info info2 s rv|
+	aStream := WriteStream on:(String new:200).
+	currentClass notNil ifTrue:[
+	    self busyLabel:'extracting revision info' with:nil.
+	    info := currentClass revisionInfo.
+	    rv := currentClass binaryRevision.
+	    rv notNil ifTrue:[
+		aStream nextPutAll:'**** Loaded classes binary information ****'; cr; cr.
+		aStream nextPutAll:'  Binary based upon : ' , rv; cr.
+		aStream cr.
+	    ].
+	    info notNil ifTrue:[
+		aStream nextPutAll:'**** Loaded classes source information ****'; cr; cr.
+		s := info at:#repositoryPath ifAbsent:nil.
+		s notNil ifTrue:[
+		    aStream nextPut:'  Source repository : ' , s; cr
+		].
+		aStream nextPutAll:'  Filename ........ : ' , (info at:#fileName ifAbsent:'?'); cr.
+		aStream nextPutAll:'  Revision ........ : ' , (info at:#revision ifAbsent:'?'); cr.
+		aStream nextPutAll:'  Checkin date .... : ' , (info at:#date ifAbsent:'?') , ' ' , (info at:#time ifAbsent:'?'); cr.
+		aStream nextPutAll:'  Checkin user .... : ' , (info at:#user ifAbsent:'?'); cr.
+		(info2 := currentClass packageSourceCodeInfo) notNil ifTrue:[
+		    aStream nextPutAll:'  Repository: ..... : ' , (info2 at:#module ifAbsent:'?'); cr.
+		    aStream nextPutAll:'  Directory: ...... : ' , (info2 at:#directory ifAbsent:'?'); cr.
+		].
+		aStream nextPutAll:'  Container ....... : ' , (info at:#repositoryPathName ifAbsent:'?'); cr.
+		aStream cr.
+		SourceCodeManager notNil ifTrue:[
+		    aStream nextPutAll:'**** Repository information ****'; cr; cr.
+		    SourceCodeManager writeRevisionLogOf:currentClass to:aStream.
+		]
+	    ] ifFalse:[
+		aStream nextPutAll:'No revision info found'
+	    ]
+	].
+	codeView contents:(aStream contents).
+	codeView modified:false.
+	codeView acceptAction:nil.
+	codeView explainAction:nil.
+	methodListView notNil ifTrue:[
+	    methodListView deselect
+	].
+	aspect := #revisionInfo.
+	self normalLabel
+]
+"Created: 14.11.1995 / 16:43:15 / cg"
+"Modified: 7.12.1995 / 11:00:56 / cg"
+!!
+classLoadRevision
+"load a specific revision into the system - especially useful to
+upgrade a class to the newest revision"
+self doClassMenu:[:currentClass |
+	|aStream comparedSource currentSource v rev revString what|
+	rev := Dialog request:'load which revision: (empty for newest)'.
+	rev notNil ifTrue:[
+	    rev withoutSpaces isEmpty ifTrue:[
+		what := currentClass name , '(newest)'.
+		self busyLabel:'extracting %1' with:what.
+		aStream := SourceCodeManager mostRecentSourceStreamForClassNamed:currentClass name.
+		revString := 'newest'
+	    ] ifFalse:[
+		what := currentClass name , '(' , rev , ')'.
+		self busyLabel:'extracting %1' with:what.
+		aStream := SourceCodeManager sourceStreamFor:currentClass revision:rev.
+		revString := rev
+	    ].
+	    self busyLabel:'loading %1' with:what .
+	    [
+		Class withoutUpdatingChangesDo:[
+		    "/ rename the current class - for backup
+		    Smalltalk renameClass:currentClass to:currentClass name , '_saved'.
+		    aStream fileIn.
+		].
+	    ] valueNowOrOnUnwindDo:[
+		aStream close.
+		self normalLabel.
+	    ].
+	]
+]
+"Created: 14.11.1995 / 16:43:15 / cg"
+"Modified: 25.11.1995 / 10:44:38 / cg"
+!! !!
+!!BrowserView methodsFor:'class stuff'!!
+checkClassSelected
+"warn and return false, if no class is selected"
+currentClass isNil ifTrue:[
+	self warn:'select a class first'.
+	^ false
+].
+^ true
+!!
+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 compile:false).
+	    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
+!!
+classListUpdate
+RememberAspect ifTrue:[
+	aspect == #hierarchy ifTrue:[
+	    ^ self classHierarchy
+	].
+	aspect == #classInstVars ifTrue:[
+	    ^ self classClassInstVars
+	].
+	aspect == #comment ifTrue:[
+	    ^ self classComment
+	].
+	aspect == #primitiveDefinitions ifTrue:[
+	    ^ self classPrimitiveDefinitions
+	].
+	aspect == #primitiveFunctions ifTrue:[
+	    ^ self classPrimitiveFunctions
+	].
+	aspect == #primitiveVariables ifTrue:[
+	    ^ self classPrimitiveVariables
+	].
+	aspect == #revisionInfo ifTrue:[
+	    ^ self classRevisionInfo
+	].
+].
+self classDefinition
+"Created: 23.11.1995 / 11:28:58 / cg"
+"Modified: 23.11.1995 / 11:36:08 / cg"
+!!
+classSelection:lineNr
+"user clicked on a class line - show method categories"
+|cls oldSelector|
+(currentClassHierarchy notNil
+and:[fullProtocol]) ifTrue:[
+	oldSelector := currentSelector.
+	self updateMethodCategoryListWithScroll:false.
+	self updateMethodListWithScroll:false.
+	self updateVariableList.
+	^ self
+].
+cls := Smalltalk classNamed:classListView selectionValue withoutSpaces.
+cls notNil ifTrue:[
+	self switchToClass:cls.
+	self classSelectionChanged
+]
+!!
+classSelectionChanged
+|oldMethodCategory oldMethod oldSelector|
+self withWaitCursorDo:[
+	oldMethodCategory := currentMethodCategory.
+	oldMethod := currentMethod.
+	oldSelector := currentSelector.
+	showInstance ifTrue:[
+	    actualClass := acceptClass := currentClass
+	] ifFalse:[
+	    actualClass := acceptClass := currentClass class
+	].
+	currentMethodCategory := nil.
+	currentMethod := nil.
+	currentSelector := nil.
+	self updateVariableList.
+	self updateMethodCategoryList.
+	oldMethodCategory notNil ifTrue:[
+	    methodCategoryListView selectElement:oldMethodCategory.
+	    methodCategoryListView hasSelection 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.
+	    ].
+	] ifFalse:[
+"/            self classDefinition.
+self classListUpdate.
+	    codeView acceptAction:[:theCode |
+		codeView cursor:Cursor execute.
+		Object abortSignal catch:[
+		    (Compiler evaluate:theCode asString notifying:codeView compile:false)
+		    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
+	    ]
+	].
+	self setDoitActionForClass
+]
+"Created: 23.11.1995 / 11:32:03 / cg"
+!!
+doClassMenu:aBlock
+"a helper - check if class is selected and evaluate aBlock
+while showing waitCursor"
+self checkClassSelected ifTrue:[
+	self withWaitCursorDo:[aBlock value:currentClass]
+]
+!!
+listOfAllClassesInCategory:aCategory
+"return a list of all classes in a given category"
+|newList classes searchCategory nm|
+(aCategory = '* hierarchy *') ifTrue:[
+	newList := OrderedCollection new.
+	classes := Set new.
+	self classHierarchyDo:[:aClass :lvl|
+	    nm := aClass name.
+	    (classes includes:nm) ifFalse:[
+		classes add:nm.
+		newList add:(String new:lvl) , nm
+	    ]
+	].
+	^ newList
+].
+newList := Set new.
+(aCategory = '* all *') ifTrue:[
+	Smalltalk allBehaviorsDo:[:aClass |
+	    newList add:aClass name
+	]
+] ifFalse:[
+	(aCategory = '* no category *') ifTrue:[
+	    searchCategory := nil
+	] ifFalse:[
+	    searchCategory := aCategory
+	].
+	Smalltalk allBehaviorsDo:[:aClass |
+	    |thisCategory|
+	    aClass isMeta ifFalse:[
+		thisCategory := aClass category.
+		((thisCategory = searchCategory)
+		or:[thisCategory = aCategory]) ifTrue:[
+		    newList add:aClass name
+		]
+	    ]
+	]
+].
+(newList size == 0) ifTrue:[^ nil].
+^ newList asOrderedCollection sort
+!!
+listOfClassHierarchyOf:aClass
+"return a hierarchy class-list"
+|startClass classes thisOne|
+showInstance ifTrue:[
+	startClass := aClass
+] ifFalse:[
+	startClass := aClass class.
+].
+classes := startClass allSuperclasses.
+thisOne := Array with:startClass.
+classes notNil ifTrue:[
+	classes := classes reverse , thisOne.
+] ifFalse:[
+	classes := thisOne
+].
+fullProtocol ifFalse:[
+	classes := classes , startClass allSubclassesInOrder
+].
+^ classes collect:[:c | c name]
+!!
+renameCurrentClassTo:aString
+"helper - do the rename"
+self doClassMenu:[:currentClass |
+	|oldName oldSym newSym cls|
+	(cls := Smalltalk classNamed:aString) notNil ifTrue:[
+	    (self confirm:(resources string:'WARN_RENAME' with:aString with:cls category))
+		ifFalse:[^ self]
+	].
+	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.
+	    SystemBrowser browseReferendsOf:oldSym warnIfNone:false
+	]
+]
+"Created: 25.11.1995 / 13:02:53 / cg"
+!!
+switchToClass:newClass
+"switch to some other class;
+keep instance protocol as it was ..."
+|cls meta|
+fullProtocol ifTrue:[^ self].
+cls := newClass.
+(meta := cls isMeta) ifTrue:[
+	cls := cls soleInstance
+].
+currentClass notNil ifTrue:[
+	currentClass removeDependent:self
+].
+currentClass := cls.
+showInstance ifTrue:[
+actualClass := acceptClass := cls.
+] ifFalse:[
+actualClass := acceptClass := cls class.
+].
+currentClass notNil ifTrue:[
+	currentClass addDependent:self.
+].
+self normalLabel.
+"Modified: 1.9.1995 / 01:04:05 / claus"
+!!
+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
+!!
+switchToClassNamed:aString
+|meta str classSymbol theClass newCat element|
+meta := false.
+str := aString.
+classSymbol := aString asSymbolIfInterned.
+classSymbol isNil ifTrue:[
+	(aString endsWith:'class') ifTrue:[
+	    str := aString copyWithoutLast:5.
+	    classSymbol := str asSymbolIfInterned.
+	    classSymbol isNil ifTrue:[
+		^ self
+	    ].
+	    meta := true
+	].
+].
+theClass := Smalltalk at:classSymbol.
+(theClass isNil and:[str endsWith:'class']) ifTrue:[
+	str := str copyWithoutLast:5.
+	classSymbol := str asSymbolIfInterned.
+	classSymbol isNil ifTrue:[
+	    ^ self
+	].
+	meta := true.
+	theClass := Smalltalk at:classSymbol.
+].
+theClass == currentClass ifTrue:[^ self].
+theClass isBehavior ifTrue:[
+	classCategoryListView notNil ifTrue:[
+	    currentClassHierarchy isNil ifTrue:[
+		((newCat := theClass category) ~= currentClassCategory) ifTrue:[
+		    currentClassCategory := newCat.
+		    newCat isNil ifTrue:[
+			element := '* no category *'
+		    ] ifFalse:[
+			element := newCat.
+		    ].
+		    classCategoryListView selectElement:element.
+		    "/ classCategoryListView makeSelectionVisible.
+		]
+	    ]
+	].
+	self updateClassList.
+	self switchToClass:theClass.
+	classListView selectElement:str.
+	self instanceProtocol:meta not.
+	self classSelectionChanged
+]
+"Modified: 1.9.1995 / 01:41:35 / claus"
+!!
+templateFor:className in:cat
+"return a class definition template - be smart in what is offered initially"
+|aString name i|
+name := 'NewClass'.
+i := 1.
+[name knownAsSymbol and:[Smalltalk includesKey:name asSymbol]] whileTrue:[
+	i := i + 1.
+	name := 'NewClass' , i printString
+].
+aString := className , ' subclass:#' , name , '
+	instanceVariableNames: ''''
+	classVariableNames: ''''
+	poolDictionaries: ''''
+	category: '''.
+cat notNil ifTrue:[
+	aString := aString , cat
+].
+aString := aString , '''
+"
+Replace ''' , className , ''', ''', name , ''' and
+the empty string arguments by true values.
+Install (or change) the class by ''accepting'',
+either via the menu or the keyboard (usually CMD-A).
+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.
+"
+'.
+^ aString
+!!
+updateClassList
+self updateClassListWithScroll:true
+!!
+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:[
+	    currentClassHierarchy notNil ifTrue:[
+		classes := self listOfClassHierarchyOf:currentClassHierarchy
+	    ]
+	].
+	classListView list = classes ifFalse:[
+	    scroll ifTrue:[
+		classListView contents:classes
+	    ] ifFalse:[
+		classListView setContents:classes
+	    ].
+	    oldClassName notNil ifTrue:[
+		classListView setContents:classes.
+		classListView selectElement:oldClassName
+	    ] ifFalse:[
+		variableListView notNil ifTrue:[variableListView contents:nil]
+	    ]
+	].
+	scroll ifTrue:[
+	    fullProtocol ifTrue:[
+		classListView scrollToBottom
+	    ]
+	]
+]
+!! !!
+!!BrowserView methodsFor:'class-method list menu'!!
+classMethodFileOutAll
+"fileout all methods into one source file"
+|list classString selectorString cls mth outStream fileName append
+fileBox|
+append := false.
+fileBox := FileSaveBox
+			title:(resources string:'save methodss in:')
+			okText:(resources string:'save')
+			abortText:(resources string:'cancel')
+			action:[:fName | fileName := fName].
+fileBox appendAction:[:fName | fileName := fName. append := true].
+fileBox initialText:'some_methods.st'.
+Project notNil ifTrue:[
+	fileBox directory:Project currentProjectDirectory
+].
+fileBox showAtPointer.
+fileName notNil ifTrue:[
+	"
+	 if file exists, save original in a .sav file
+	"
+	fileName asFilename exists ifTrue:[
+	    fileName asFilename copyTo:(fileName , '.sav')
+	].
+	append ifTrue:[
+	    outStream := FileStream appendingOldFileNamed:fileName
+	] ifFalse:[
+	    outStream := FileStream newFileNamed:fileName.
+	].
+	outStream isNil ifTrue:[
+	    ^ self warn:'cannot create: %1' with:fileName
+	].
+	self withWaitCursorDo:[
+	    list := classMethodListView list.
+	    list do:[:line |
+		self busyLabel:'writing: ' with:line.
+		classString := self classFromClassMethodString:line.
+		selectorString := self selectorFromClassMethodString:line.
+		((classString ~= 'Metaclass') and:[classString endsWith:'class']) ifTrue:[
+		    classString := classString copyWithoutLast:5 "copyTo:(classString size - 5)".
+		    cls := (Smalltalk at:classString asSymbol).
+		    cls := cls class
+		] ifFalse:[
+		    cls := (Smalltalk at:classString asSymbol).
+		].
+		cls isNil ifTrue:[
+		    self warn:'oops class %1 is gone' with:classString
+		] ifFalse:[
+		    mth := cls compiledMethodAt:(selectorString asSymbol).
+		    Class fileOutErrorSignal handle:[:ex |
+			|box|
+			box := YesNoBox
+				    title:('fileOut error: '
+					   , ex errorString
+					   , '\\continue anyway ?') withCRs
+				    yesText:'continue'
+				    noText:'abort'.
+			box confirm ifTrue:[
+			    ex proceed
+			].
+			self normalLabel.
+			^ self
+		    ] do:[
+			cls fileOutMethod:mth on:outStream.
+		    ]
+		]
+	    ].
+	    outStream close.
+	    self normalLabel.
+	]
+]
+!!
+classMethodMenu
+|labels selectors|
+labels := #(
+				'fileOut'
+				'fileOut all'
+				'printOut'
+				'-'
+				'spawn'
+				'spawn class'
+				'spawn full protocol'
+				'spawn hierarchy'
+				'-'
+				'senders ...'
+				'implementors ...'
+				'globals ...'
+"/                              '-'
+"/                              'breakpoint'
+"/                              'trace'
+"/                              'trace sender'
+				'-'
+				'remove'
+	       ).
+selectors := #(
+				methodFileOut
+				classMethodFileOutAll
+				methodPrintOut
+				nil
+				methodSpawn
+				classSpawn
+				classSpawnFullProtocol
+				classSpawnHierarchy
+				nil
+				methodSenders
+				methodImplementors
+				methodGlobalReferends
+"/                              nil
+"/                              methodBreakPoint
+"/                              methodTrace
+"/                              methodTraceSender
+				nil
+				methodRemove
+		  ).
+^ PopUpMenu labels:(resources array:labels)
+		selectors:selectors
+!! !!
+!!BrowserView methodsFor:'class-method stuff'!!
+classFromClassMethodString:aString
+"helper for classMethod-list - extract class name from the string"
+"/    |pos|
+"/
+"/    pos := aString indexOf:(Character space).
+"/    ^ aString copyTo:(pos - 1)
+^ aString upTo:Character space
+!!
+classMethodSelection:lineNr
+"user clicked on a class/method line - show code"
+|cls string classString selectorString meta|
+string := classMethodListView selectionValue.
+classString := self classFromClassMethodString:string.
+selectorString := self selectorFromClassMethodString:string.
+((classString ~= 'Metaclass') and:[classString endsWith:'class']) ifTrue:[
+	classString := classString copyWithoutLast:5 "copyTo:(classString size - 5)".
+	meta := true.
+] ifFalse:[
+	meta := false.
+].
+self switchToClass:(Smalltalk at:classString asSymbol).
+meta ifTrue:[cls := currentClass class] ifFalse:[cls := currentClass].
+actualClass := acceptClass := cls.
+currentClass isNil ifTrue:[
+	self warn:'oops class is gone'
+] ifFalse:[
+	currentClassCategory := currentClass category.
+	currentSelector := selectorString asSymbol.
+	currentMethod := actualClass compiledMethodAt:currentSelector.
+	currentMethod isNil ifTrue:[
+	    self warn:'oops method is gone'
+	] ifFalse:[
+	    currentMethodCategory := currentMethod category.
+	].
+	self methodSelectionChanged
+].
+self setDoitActionForClass
+"Modified: 31.8.1995 / 11:56:02 / claus"
+!!
+selectorFromClassMethodString:aString
+"helper for classMethod-list - extract selector from the string"
+|pos|
+pos := aString indexOf:(Character space).
+^ aString copyFrom:(pos + 1)
+!! !!
+!!BrowserView methodsFor:'help'!!
+helpTextFor:aComponent
+|s|
+aComponent == classCategoryListView ifTrue:[
+	s := 'HELP_CCAT_LIST'
+].
+aComponent == classListView ifTrue:[
+	fullProtocol ifTrue:[
+	    s := 'HELP_PCLASS_LIST'
+	] ifFalse:[
+	    currentClassHierarchy notNil ifTrue:[
+		s := 'HELP_HCLASS_LIST'
+	    ] ifFalse:[
+		s := 'HELP_CLASS_LIST'
+	    ]
+	]
+].
+aComponent == methodCategoryListView ifTrue:[
+	s := 'HELP_MCAT_LIST'
+].
+aComponent == methodListView ifTrue:[
+	s := 'HELP_METHOD_LIST'
+].
+aComponent == variableListView ifTrue:[
+	s := 'HELP_VAR_LIST'
+].
+aComponent == codeView ifTrue:[
+	fullClass ifTrue:[
+	    s := 'HELP_FULLCODE_VIEW'
+	] ifFalse:[
+	    s := 'HELP_CODE_VIEW'
+	]
+].
+(aComponent == instanceToggle
+or:[aComponent == classToggle]) ifTrue:[
+	s := 'HELP_INST_CLASS_TOGGLE'
+].
+aComponent == classMethodListView ifTrue:[
+	s := 'HELP_CLSMTHOD_LIST'
+].
+s notNil ifTrue:[
+	^ resources string:s
+].
+^ nil
+"Modified: 31.8.1995 / 19:11:39 / claus"
+!! !!
+!!BrowserView methodsFor:'initialize / release'!!
+autoSearch:aString
+"used with class-method list browsing. If true,
+selecting an entry from the list will automatically
+search for the searchstring in the codeView"
+self setSearchPattern:aString.
+autoSearch := aString
+!!
+destroy
+"relese dependant - destroy popups"
+Smalltalk removeDependent:self.
+currentClass notNil ifTrue:[
+	currentClass removeDependent:self.
+	currentClass := nil
+].
+super destroy
+!!
+initialize
+super initialize.
+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).
+	"
+	 tell classCategoryListView to ask for the menu
+	"
+	v menuHolder:self; menuPerformer:self; menuMessage:#classCategoryMenu.
+].
+v := classListView.
+v notNil ifTrue:[
+	v action:[:lineNr | self classSelection:lineNr].
+	v selectConditionBlock:checkBlock.
+	v ignoreReselect:false.
+	"
+	 tell classListView to ask for the menu
+	"
+	v menuHolder:self; menuPerformer:self; menuMessage:#classMenu.
+].
+v := methodCategoryListView.
+v notNil ifTrue:[
+	v action:[:lineNr | self methodCategorySelection:lineNr].
+	v selectConditionBlock:checkBlock.
+	v ignoreReselect:false.
+	"
+	 tell methodCategoryListView to ask for the menu
+	"
+	v menuHolder:self; menuPerformer:self; menuMessage:#methodCategoryMenu.
+].
+v := methodListView.
+v notNil ifTrue:[
+	v action:[:lineNr | self methodSelection:lineNr].
+	v selectConditionBlock:checkBlock.
+	v ignoreReselect:false.
+	"
+	 tell methodListView to ask for the menu
+	"
+	v menuHolder:self; menuPerformer:self; menuMessage:#methodMenu.
+].
+v := classMethodListView.
+v notNil ifTrue:[
+	v action:[:lineNr | self classMethodSelection:lineNr].
+	v selectConditionBlock:checkBlock.
+	v ignoreReselect:false.
+	"
+	 tell classMethodListView to ask for the menu
+	"
+	v menuHolder:self; menuPerformer:self; menuMessage:#classMethodMenu.
+].
+v := variableListView.
+v notNil ifTrue:[
+	v action:[:lineNr | self variableSelection:lineNr].
+	v ignoreReselect:false.
+	v toggleSelect:true.
+	v menuHolder:self; menuPerformer:self; menuMessage:#variableListMenu.
+].
+"
+normal browsers show the top at first;
+hierarchy and fullProtocol browsers better show the end
+initially
+"
+currentClassHierarchy notNil ifTrue:[
+	classListView scrollToBottom.
+]
+!!
+terminate
+(self checkSelectionChangeAllowed) ifTrue:[
+	super terminate
+]
+!!
+title:someString
+myLabel := someString.
+self label:someString.
+!! !!
+!!BrowserView methodsFor:'initialize subviews'!!
+createClassListViewIn:frame
+"setup the classlist subview, with its toggles"
+|v panel|
+self createTogglesIn:frame.
+"
+oldstyle had no variableList ...
+"
+"/    v := ScrollableView for:SelectionInListView in:frame.
+"/    v origin:(0.0 @ 0.0)
+"/      extent:[frame width
+"/            @
+"/           (frame height
+"/            - ViewSpacing
+"/            - instanceToggle height
+"/            - instanceToggle borderWidth
+"/            + v borderWidth)].
+"/
+"/    classListView := v scrolledView
+panel := VariableVerticalPanel
+		    origin:(0.0 @ 0.0)
+		    corner:[frame width
+			    @
+			    (frame height
+			      - ViewSpacing
+			      - instanceToggle height
+			      "-" "+ instanceToggle borderWidth "
+			      + v borderWidth)]
+			in:frame.
+v := ScrollableView for:SelectionInListView in:panel.
+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.7) corner:(1.0 @ 1.0).
+variableListView := v scrolledView.
+!!
+createCodeViewIn:aView
+"setup the code view"
+^ self createCodeViewIn:aView at:0.25
+!!
+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"
+|h halfSpace classAction instanceAction|
+classAction := [self instanceProtocol:false].
+instanceAction := [self instanceProtocol:true].
+halfSpace := ViewSpacing // 2.
+instanceToggle := Toggle label:(resources at:'instance') in:aFrame.
+h := instanceToggle heightIncludingBorder.
+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 heightIncludingBorder.
+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 bottomInset:halfSpace.
+	classToggle bottomInset:halfSpace.
+	instanceToggle leftInset:halfSpace.
+	classToggle leftInset:halfSpace.
+	instanceToggle rightInset:ViewSpacing - halfSpace.
+	classToggle rightInset:ViewSpacing - halfSpace.
+].
+!!
+focusSequence
+|s|
+s := OrderedCollection new.
+classCategoryListView notNil ifTrue:[
+	s add:classCategoryListView
+].
+classListView notNil ifTrue:[
+	s add:classListView
+].
+"/    variableListView notNil ifTrue:[
+"/        s add:variableListView
+"/    ].
+instanceToggle notNil ifTrue:[
+	s add:instanceToggle.
+].
+methodCategoryListView notNil ifTrue:[
+	s add:methodCategoryListView
+].
+methodListView notNil ifTrue:[
+	s add:methodListView
+].
+classMethodListView notNil ifTrue:[
+	s add:classMethodListView
+].
+s add:codeView.
+^ s
+!!
+setupForAll
+"create subviews for a full browser"
+|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.
+v := HVScrollableView for:SelectionInListView
+			  miniScrollerH:true miniScrollerV:false
+			  in:hpanel.
+v origin:(0.0 @ 0.0) corner:(0.25 @ 1.0).
+classCategoryListView := v scrolledView.
+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 origin:(0.5 @ 0.0) corner:(0.75 @ 1.0).
+methodCategoryListView := v scrolledView.
+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 createCodeViewIn:vpanel
+!!
+setupForClass:aClass
+"create subviews for browsing a single class"
+|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.5 @ 1.0)in:hpanel.
+self createTogglesIn:frame.
+v := ScrollableView for:SelectionInListView in:frame.
+v origin:(0.0 @ 0.0)
+extent:[frame width
+	      @
+	      (frame height
+	       - ViewSpacing
+	       - instanceToggle height
+	       - instanceToggle borderWidth
+	       + v borderWidth)].
+methodCategoryListView := v scrolledView.
+v := ScrollableView for:SelectionInListView in:hpanel.
+v origin:(0.5 @ 0.0) corner:(1.0 @ 1.0).
+methodListView := v scrolledView.
+self createCodeViewIn:vpanel.
+self switchToClass:aClass.
+actualClass := acceptClass := aClass.
+self updateMethodCategoryList.
+self updateMethodList.
+self updateCodeView.
+self classDefinition.
+!!
+setupForClass:aClass methodCategory:aMethodCategory
+"setup subviews to browse a method category"
+|vpanel v|
+vpanel := VariableVerticalPanel
+			origin:(0.0 @ 0.0) corner:(1.0 @ 1.0)
+			    in:self.
+v := ScrollableView for:SelectionInListView in:vpanel.
+v origin:(0.0 @ 0.0) corner:(1.0 @ 0.25).
+methodListView := v scrolledView.
+self createCodeViewIn:vpanel.
+currentClassCategory := aClass category.
+self switchToClass:aClass.
+actualClass := acceptClass := aClass.
+currentMethodCategory := aMethodCategory.
+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 := acceptClass := aClass.
+currentSelector := selector.
+currentMethod := currentClass compiledMethodAt:selector.
+currentMethodCategory := currentMethod category.
+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
+!!
+setupForClassHierarchy:aClass
+"setup subviews to browse a class hierarchy"
+|vpanel hpanel frame v cls|
+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.
+cls := aClass.
+cls isMeta ifTrue:[
+	cls := cls soleInstance
+].
+currentClassHierarchy := currentClass := actualClass := cls.
+self updateClassList.
+classListView selectElement:aClass name; makeSelectionVisible.
+self updateMethodCategoryList.
+self updateMethodList.
+self updateCodeView.
+aClass isMeta ifTrue:[
+	self instanceProtocol:false
+].
+!!
+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]) asOrderedCollection.
+classListView list:(l sort).
+self updateMethodCategoryList.
+self updateMethodList.
+self updateCodeView
+!!
+setupForFullClass
+"setup subviews to browse a class as full text"
+|vpanel hpanel 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.
+v := ScrollableView for:SelectionInListView in:hpanel.
+v origin:(0.0 @ 0.0) corner:(0.5 @ 1.0).
+classCategoryListView := v scrolledView.
+classCategoryListView contents:(self listOfAllClassCategories).
+v := ScrollableView for:SelectionInListView in:hpanel.
+v origin:(0.5 @ 0.0) corner:(1.0 @ 1.0).
+classListView := v scrolledView.
+self createCodeViewIn:vpanel.
+fullClass := true.
+self updateCodeView
+!!
+setupForFullClassProtocol:aClass
+"setup subviews to browse a classes full protocol"
+|vpanel hpanel frame v cls|
+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.
+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 createCodeViewIn:vpanel at:0.4.
+cls := aClass.
+cls isMeta ifTrue:[
+	cls := cls soleInstance
+].
+currentClassHierarchy := actualClass := acceptClass := currentClass := cls.
+fullProtocol := true.
+self updateClassList.
+self updateMethodCategoryList.
+self updateMethodList.
+self updateCodeView.
+self updateVariableList.
+aClass isMeta ifTrue:[
+	self instanceProtocol:false
+].
+!!
+setupForList:aList
+"setup subviews to browse methods from a list"
+|vpanel v|
+vpanel := VariableVerticalPanel
+			origin:(0.0 @ 0.0)
+			corner:(1.0 @ 1.0)
+			    in:self.
+v := ScrollableView for:SelectionInListView in:vpanel.
+v origin:(0.0 @ 0.0) corner:(1.0 @ 0.25).
+classMethodListView := v scrolledView.
+classMethodListView contents:aList.
+self createCodeViewIn:vpanel.
+aList size == 1 ifTrue:[
+	classMethodListView selection:1.
+	self classMethodSelection:1.
+].
+self updateCodeView
+!! !!
+!!BrowserView methodsFor:'method category list menu'!!
+methodCategoryCopyCategory
+"show the enter box to copy from an existing method category"
+|title box|
+showInstance ifTrue:[
+	title := 'class to copy instance method category from:'
+] ifFalse:[
+	title := 'class to copy class method category from:'
+].
+box := self listBoxTitle:title
+		      okText:'ok'
+			list:(Smalltalk allClasses collect:[:cls | cls name]) asArray sort.
+box action:[:aString | self copyMethodsFromClass:aString].
+box showAtPointer
+!!
+methodCategoryCreateAccessMethods
+"create access methods for all instvars"
+self checkClassSelected ifFalse:[^ self].
+showInstance ifFalse:[
+	self warn:'select instance - and try again'.
+	^ self.
+].
+self withWaitCursorDo:[
+	|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:[
+		Transcript showCr:'method ''', name , ''' already present'
+	    ].
+	    (currentClass implements:((name , ':') asSymbol)) ifFalse:[
+		source := (name , ':something\    "set ' , name , '"\\    ' , name , ' := something.') withCRs.
+		Compiler compile:source forClass:currentClass inCategory:'accessing'.
+	    ] ifTrue:[
+		Transcript showCr:'method ''', name , ':'' already present'
+	    ].
+	].
+	self updateMethodCategoryListWithScroll:false.
+	self updateMethodListWithScroll:false
+]
+!!
+methodCategoryCreateDocumentationMethods
+"create empty documentation methods"
+|cls histStream|
+self checkClassSelected ifFalse:[^ self].
+cls := currentClass class.
+self withWaitCursorDo:[
+	|nm names source|
+	"/ add version method containing RCS template
+	"/ but only if not already present.
+	(cls implements:#version) ifFalse:[
+	    Compiler compile:
+'version
+"
+$' , 'Header$
+"
+'                   forClass:cls
+		  inCategory:'documentation'.
+	].
+	"/ add documentation method containing doc template
+	"/ but only if not already present.
+	(cls implements:#documentation) ifFalse:[
+	    Compiler compile:
+'documentation
+"
+documentation to be added.
+"
+'                   forClass:cls
+		  inCategory:'documentation'.
+	].
+	"/ add examples method containing examples template
+	"/ but only if not already present.
+	(cls implements:#examples) ifFalse:[
+	    Compiler compile:
+'examples
+"
+examples to be added.
+"
+'                   forClass:cls
+		  inCategory:'documentation'.
+	].
+	"/ add history method containing created-entry
+	"/ but only if not already present.
+	(cls implements:#history) ifFalse:[
+	    histStream := ReadWriteStream on: String new.
+	    histStream nextPutAll: 'history'; cr.
+	    HistoryLine isBehavior ifTrue:[
+		histStream nextPutAll: (HistoryLine newCreated printString); cr.
+	    ] ifFalse:[
+		histStream cr.
+	    ].
+	    Compiler compile:(histStream contents)
+		    forClass:cls
+		  inCategory:'documentation'.
+	].
+	self instanceProtocol:false.
+	self switchToMethodNamed:#documentation
+"/        self updateMethodCategoryListWithScroll:false.
+"/        self updateMethodListWithScroll:false
+]
+!!
+methodCategoryFileOut
+"fileOut all methods in the selected methodcategory of
+the current class"
+self checkClassSelected ifFalse:[^ self].
+self whenMethodCategorySelected:[
+	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.
+]
+!!
+methodCategoryFileOutAll
+"fileOut all methods in the selected methodcategory of
+the current class"
+self whenMethodCategorySelected:[
+	|fileName outStream|
+	fileName := currentMethodCategory , '.st'.
+	fileName replaceAll:Character space by:$_.
+	"
+	 this test allows a smalltalk to be built without Projects/ChangeSets
+	"
+	Project notNil ifTrue:[
+	    fileName := Project currentProjectDirectory , fileName.
+	].
+	"
+	 if file exists, save original in a .sav file
+	"
+	fileName asFilename exists ifTrue:[
+	    fileName asFilename copyTo:(fileName , '.sav')
+	].
+	outStream := FileStream newFileNamed:fileName.
+	outStream isNil ifTrue:[
+	    ^ self warn:'cannot create: %1' with:fileName
+	].
+	self busyLabel:'saving: ' with:currentMethodCategory.
+	Class fileOutErrorSignal handle:[:ex |
+	    self warn:'cannot create: %1' with:ex parameter.
+	    ex return
+	] do:[
+	    Smalltalk allBehaviorsDo:[:class |
+		|hasMethodsInThisCategory|
+		hasMethodsInThisCategory := false.
+		class methodArray do:[:method |
+		    method category = currentMethodCategory ifTrue:[
+			hasMethodsInThisCategory := true
+		    ]
+		].
+		hasMethodsInThisCategory ifTrue:[
+		    class fileOutCategory:currentMethodCategory on:outStream.
+		    outStream cr
+		].
+		hasMethodsInThisCategory := false.
+		class class methodArray do:[:method |
+		    method category = currentMethodCategory ifTrue:[
+			hasMethodsInThisCategory := true
+		    ]
+		].
+		hasMethodsInThisCategory ifTrue:[
+		    class class fileOutCategory:currentMethodCategory on:outStream.
+		    outStream cr
+		]
+	    ].
+	].
+	outStream close.
+	self normalLabel.
+].
+!!
+methodCategoryFindAnyMethod
+|box|
+box := self enterBoxForSearchSelectorTitle:'method selector to search for:'.
+box action:[:aString | self switchToAnyMethodNamed:aString].
+box showAtPointer
+!!
+methodCategoryFindMethod
+|box|
+box := self enterBoxForSearchSelectorTitle:'method selector to search for:'.
+box action:[:aString | self switchToMethodNamed:aString].
+box showAtPointer
+!!
+methodCategoryMenu
+|labels selectors i|
+currentClass isNil ifTrue:[
+	methodCategoryListView flash.
+	^ nil
+].
+currentMethodCategory isNil ifTrue:[
+	labels := #(
+		    'find method here ...'
+		    'find method ...'
+		    '-'
+		    'new category ...'
+		    'copy category ...'
+		    'create access methods'
+		   ).
+	selectors := #(
+		    methodCategoryFindMethod
+		    methodCategoryFindAnyMethod
+		    nil
+		    methodCategoryNewCategory
+		    methodCategoryCopyCategory
+		    methodCategoryCreateAccessMethods
+		   ).
+] ifFalse:[
+	labels := #(
+		    'fileOut'
+		    'fileOut all'
+		    'printOut'
+		    '-'
+		    'SPAWN_METHODCATEGORY'
+		    'spawn category'
+		    '-'
+		    'find method here ...'
+		    'find method ...'
+		    '-'
+		    'new category ...'
+		    'copy category ...'
+		    'create access methods'
+		    'rename ...'
+		    'remove'
+		   ).
+	selectors := #(
+		    methodCategoryFileOut
+		    methodCategoryFileOutAll
+		    methodCategoryPrintOut
+		    nil
+		    methodCategorySpawn
+		    methodCategorySpawnCategory
+		    nil
+		    methodCategoryFindMethod
+		    methodCategoryFindAnyMethod
+		    nil
+		    methodCategoryNewCategory
+		    methodCategoryCopyCategory
+		    methodCategoryCreateAccessMethods
+		    methodCategoryRename
+		    methodCategoryRemove
+		   ).
+].
+showInstance ifFalse:[
+	labels := labels copy.
+	selectors := selectors copy.
+	i := labels indexOf:'create access methods'.
+	labels at:i put:'create documentation stubs'.
+	selectors at:i put:#methodCategoryCreateDocumentationMethods
+].
+^ PopUpMenu labels:(resources array:labels)
+		 selectors:selectors
+!!
+methodCategoryNewCategory
+"show the enter box to add a new method category.
+Offer existing superclass categories in box to help avoiding
+useless typing."
+|someCategories existingCategories box|
+actualClass notNil ifTrue:[
+	someCategories := actualClass allCategories
+] ifFalse:[
+	"
+	 mhmh - offer some typical categories ...
+	"
+	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
+!!
+methodCategoryPrintOut
+|printStream|
+self checkClassSelected ifFalse:[^ self].
+self whenMethodCategorySelected:[
+	printStream := Printer new.
+	actualClass printOutCategory:currentMethodCategory on:printStream.
+	printStream close
+]
+!!
+methodCategoryRemove
+"show number of methods to remove and query user"
+|count t box|
+currentMethodCategory notNil ifTrue:[
+	count := 0.
+	actualClass methodArray do:[:aMethod |
+	    (aMethod category = currentMethodCategory) ifTrue:[
+		count := count + 1
+	    ]
+	].
+	(count == 0) ifTrue:[
+	    currentMethodCategory := nil.
+	    currentMethod := currentSelector := nil.
+	    self updateMethodCategoryListWithScroll:false.
+	    self updateMethodList
+	] ifFalse:[
+	    (count == 1) ifTrue:[
+		t := 'remove %1\(with 1 method) ?'
+	    ] ifFalse:[
+		t := 'remove %1\(with %2 methods) ?'
+	    ].
+	    t := resources string:t with:currentMethodCategory with:count printString.
+	    t := t withCRs.
+	    box := YesNoBox
+		       title:t
+		       yesText:(resources at:'remove')
+		       noText:(resources at:'abort').
+	    box confirm ifTrue:[
+		actualClass methodArray do:[:aMethod |
+		    (aMethod category = currentMethodCategory) ifTrue:[
+			actualClass
+			    removeSelector:(actualClass selectorAtMethod:aMethod)
+		    ]
+		].
+		currentMethodCategory := nil.
+		currentMethod := currentSelector := nil.
+		self updateMethodCategoryList.
+		self updateMethodList
+	    ]
+	]
+]
+!!
+methodCategoryRename
+"launch an enterBox to rename current method category"
+|box|
+self checkMethodCategorySelected ifFalse:[^ self].
+box := self enterBoxTitle:(resources string:'rename method category %1 to:' with:currentMethodCategory)
+		okText:(resources at:'rename').
+box initialText:currentMethodCategory.
+box action:[:aString |
+	actualClass renameCategory:currentMethodCategory to:aString.
+	currentMethodCategory := aString.
+	currentMethod := currentSelector := nil.
+	self updateMethodCategoryList.
+	self updateMethodListWithScroll:false
+].
+box showAtPointer
+!!
+methodCategorySpawn
+"create a new SystemBrowser browsing current method category"
+currentMethodCategory notNil ifTrue:[
+	self withWaitCursorDo:[
+	    SystemBrowser 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 |
+					SystemBrowser browseMethodCategory:aString
+				    ]
+!! !!
+!!BrowserView methodsFor:'method category stuff'!!
+checkMethodCategorySelected
+currentMethodCategory isNil ifTrue:[
+	self warn:'select a method category first'.
+	^ false
+].
+^ true
+!!
+copyMethodsFromClass:aClassName
+|class box|
+currentClass notNil ifTrue:[
+	class := Smalltalk classNamed:aClassName.
+	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
+currentClass notNil ifTrue:[
+	Object abortSignal catch:[
+	    class methodArray do:[:aMethod |
+		|source|
+		(category match:aMethod category) ifTrue:[
+		    source := aMethod source.
+		    codeView contents:source.
+		    codeView modified:false.
+		    actualClass compilerClass
+			 compile:source
+			 forClass:actualClass
+			 inCategory:aMethod category
+			 notifying:codeView.
+		    self updateMethodCategoryListWithScroll:false.
+		    self updateMethodListWithScroll:false.
+		]
+	    ]
+	]
+]
+!!
+listOfAllMethodCategoriesInClass:aClass
+"answer a list of all method categories of the argument, aClass"
+|newList|
+newList := Set new.
+aClass methodArray do:[:aMethod |
+	|cat|
+	cat := aMethod category.
+	cat isNil ifTrue:[
+	    cat := '* no category *'
+	].
+	newList add:cat
+].
+(newList size == 0) ifTrue:[^ nil].
+newList add:'* all *'.
+^ newList asOrderedCollection sort
+!!
+listOfAllMethodCategoriesInFullProtocolHierarchy:aClass
+"answer a list of all method categories of the argument, aClass,
+and all of its superclasses.
+Used with fullProtocol browsing."
+|newList|
+newList := Set new.
+self classesInFullProtocolHierarchy:aClass do:[:c |
+	|cat|
+	c methodArray do:[:aMethod |
+	    cat := aMethod category.
+	    cat isNil ifTrue:[
+		cat := '* no category *'
+	    ].
+	    newList add:cat
+	]
+].
+(newList size == 0) ifTrue:[^ nil].
+newList add:'* all *'.
+^ newList asOrderedCollection 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.
+aspect := nil.
+"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 hasSelection ifTrue:[
+"/              self methodSelection:methodListView selection.
+"/          ]
+"/      ]
+]
+"Created: 23.11.1995 / 14:19:56 / cg"
+!!
+methodCategorySelectionChanged
+"method category selection has changed - update dependent views"
+self withWaitCursorDo:[
+	currentMethod := currentSelector := nil.
+	self updateMethodList.
+	self updateCodeView.
+	currentMethodCategory notNil ifTrue:[
+	    methodCategoryListView selectElement:currentMethodCategory
+	].
+	self setAcceptAndExplainActionsForMethod.
+	self hilightMethodsInMethodCategoryList:false inMethodList:true.
+]
+"Created: 23.11.1995 / 14:17:38 / cg"
+"Modified: 23.11.1995 / 14:19:49 / cg"
+!!
+newMethodCategory:aString
+|categories|
+currentClass isNil ifTrue:[
+	^ self warn:'select/create a class first'.
+].
+categories := methodCategoryListView list.
+categories isNil ifTrue:[categories := OrderedCollection new].
+(categories includes:aString) ifFalse:[
+	categories add:aString.
+	categories sort.
+	methodCategoryListView contents:categories
+].
+currentMethodCategory := aString.
+self methodCategorySelectionChanged
+!!
+updateMethodCategoryList
+self updateMethodCategoryListWithScroll:true
+!!
+updateMethodCategoryListWithScroll:scroll
+|categories|
+methodCategoryListView notNil ifTrue:[
+	fullProtocol ifTrue:[
+	    currentClassHierarchy notNil ifTrue:[
+		categories := self listOfAllMethodCategoriesInFullProtocolHierarchy:actualClass
+	    ]
+	] 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
+	    ]
+	]
+]
+!!
+whenMethodCategorySelected:aBlock
+self checkMethodCategorySelected ifTrue:[
+	self withWaitCursorDo:aBlock
+]
+!! !!
+!!BrowserView methodsFor:'method list menu'!!
+commonTraceHelperWith:aSelector
+currentMethod := MessageTracer perform:aSelector with:currentMethod.
+self updateMethodListWithScroll:false keepSelection:true.
+currentClass changed:#methodDictionary with:currentSelector.
+!!
+methodAproposSearch
+"launch an enterBox for a keyword search"
+self askForSelectorTitle:'keyword to search for:'
+		    openWith:#aproposSearch:
+!!
+methodBreakPoint
+"set a breakpoint on the current method"
+currentSelector notNil ifTrue:[
+	currentMethod := actualClass compiledMethodAt:currentSelector.
+	currentMethod isWrapped ifFalse:[
+	    (currentMethod notNil and:[currentMethod isWrapped not]) ifTrue:[
+		self commonTraceHelperWith:#trapMethod:
+	    ]
+	].
+]
+!!
+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].
+actualClass isNil ifTrue:[
+	box := self enterBoxTitle:'' okText:'change'.
+] ifFalse:[
+	|someCategories|
+	someCategories := actualClass categories sort.
+	box := self listBoxTitle:'' okText:'change' list:someCategories.
+].
+box title:('change category from ''' , currentMethod category , ''' to:').
+lastMethodCategory isNil ifTrue:[
+	txt := currentMethod category.
+] ifFalse:[
+	txt := lastMethodCategory
+].
+box initialText:txt.
+box action:[:aString |
+		    lastMethodCategory := aString.
+		    currentMethod category:aString asSymbol.
+		    actualClass changed.
+		    currentMethod changed:#category.
+		    actualClass updateRevisionString.
+		    actualClass addChangeRecordForMethodCategory:currentMethod category:aString.
+		    self updateMethodCategoryListWithScroll:false.
+		    self updateMethodListWithScroll:false
+	       ].
+box showAtPointer
+"Created: 29.10.1995 / 19:59:22 / cg"
+!!
+methodDecompile
+"decompile the current methods bytecodes.
+The Decompiler is delivered as an extra, and not normally
+avaliable with the system."
+self checkMethodSelected ifFalse:[^ self].
+Decompiler notNil ifTrue:[
+	Autoload autoloadFailedSignal handle:[:ex |
+	    ex return
+	] do:[
+	    Decompiler autoload.
+	].
+].
+Decompiler isLoaded ifFalse:[
+	Smalltalk
+	    fileIn:'/phys/clam/claus/work/libcomp/not_delivered/Decomp.st'
+	    logged:false.
+].
+Decompiler isLoaded ifFalse:[
+	^ self warn:'No decompiler available'.
+].
+Decompiler decompile:currentMethod.
+!!
+methodFileOut
+"file out the current method"
+self checkMethodSelected ifFalse:[^ self].
+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.
+!!
+methodGlobalReferends
+"launch an enterBox for global symbol to search for"
+self enterBoxForBrowseTitle:'global variable to browse users of:'
+			 action:[:aString |
+				    SystemBrowser browseReferendsOf:aString asSymbol
+				]
+!!
+methodImplementors
+"launch an enterBox for selector to search for"
+self askForSelectorTitle:'selector to browse implementors of:'
+		    openWith:#browseImplementorsOf:
+!!
+methodInspect
+"inspect  the current method"
+self checkMethodSelected ifFalse:[^ self].
+(actualClass compiledMethodAt:currentSelector) inspect.
+!!
+methodLocalAproposSearch
+"launch an enterBox for a local keyword search"
+self askForSelectorTitle:'keyword to search for:'
+		    openWith:#aproposSearch:in:
+			 and:(currentClass withAllSubclasses)
+!!
+methodLocalImplementors
+"launch an enterBox for selector to search for"
+self checkClassSelected ifFalse:[^ self].
+self askForSelectorTitle:'selector to browse local implementors of:'
+		    openWith:#browseImplementorsOf:under:
+			 and:currentClass
+!!
+methodLocalSenders
+"launch an enterBox for selector to search for in current class & subclasses"
+self checkClassSelected ifFalse:[^ self].
+self askForSelectorTitle:'selector to browse local senders of:'
+		    openWith:#browseCallsOn:under:
+			 and:currentClass
+!!
+methodLocalStringSearch
+"launch an enterBox for string to search for"
+self checkClassSelected ifFalse:[^ self].
+self askForSelectorTitle:'string to search for in local methods:'
+		    openWith:#browseForString:in:
+			 and:(currentClass withAllSubclasses)
+!!
+methodLocalSuperSends
+"launch a browser showing super sends in current class & subclasses"
+self checkClassSelected ifFalse:[^ self].
+self withSearchCursorDo:[
+	SystemBrowser browseSuperCallsUnder:currentClass
+]
+"Created: 23.11.1995 / 12:03:57 / cg"
+"Modified: 23.11.1995 / 14:12:15 / cg"
+!!
+methodMakePrivate
+"make the current method private.
+EXPERIMENTAL"
+self methodPrivacy:#private
+!!
+methodMakeProtected
+"make the current method protected.
+EXPERIMENTAL"
+self methodPrivacy:#protected
+!!
+methodMakePublic
+"make the current method public.
+EXPERIMENTAL"
+self methodPrivacy:#public
+!!
+methodMenu
+"return a popupmenu as appropriate for the methodList"
+|m labels selectors
+newLabels newSelectors
+mthdLabels mthdSelectors
+brkLabels brkSelectors
+fileLabels fileSelectors
+searchLabels searchSelectors
+sepLocalLabels sepLocalSelectors
+localSearchLabels localSearchSelectors|
+device ctrlDown ifTrue:[
+	"/ 'secret' developpers menu
+	currentMethod isNil ifTrue:[
+	    methodListView flash.
+	    ^ nil
+	].
+	labels := #(
+			'inspect method'
+			'compile to machine code'
+			'decompile'
+			'-'
+			'make private'
+			'make protected'
+			'make public'
+		   ).
+	selectors := #(
+			methodInspect
+			methodSTCCompile
+			methodDecompile
+			nil
+			methodMakePrivate
+			methodMakeProtected
+			methodMakePublic
+		      )
+] ifFalse:[
+	sepLocalLabels := sepLocalSelectors := #().
+	searchLabels := #(
+				    'senders ...'
+				    'implementors ...'
+				    'globals ...'
+				    'string search ...'
+				    'apropos ...'
+			).
+	searchSelectors := #(
+				    methodSenders
+				    methodImplementors
+				    methodGlobalReferends
+				    methodStringSearch
+				    methodAproposSearch
+			    ).
+	currentClass notNil ifTrue:[
+	    localSearchLabels := #(
+				    '-'
+				    'local senders ...'
+				    'local implementors ...'
+				    'local super sends ...'
+				    'local string search ...'
+				    'local apropos ...'
+				).
+	    localSearchSelectors := #(
+				    nil
+				    methodLocalSenders
+				    methodLocalImplementors
+				    methodLocalSuperSends
+				    methodLocalStringSearch
+				    methodLocalAproposSearch
+				  ).
+	] ifFalse:[
+	    localSearchLabels := localSearchSelectors := #()
+	].
+	currentMethodCategory notNil ifTrue:[
+	    sepLocalLabels := #('-'). sepLocalSelectors := #(nil).
+	    newLabels :=           #(
+				    'new method'
+				    ).
+	    newSelectors :=    #(
+				    methodNewMethod
+				 ).
+	] ifFalse:[
+	    newLabels := newSelectors := #()
+	].
+	currentMethod notNil ifTrue:[
+	    fileLabels :=           #(
+				    'fileOut'
+				    'printOut'
+				    '-'
+				    'SPAWN_METHOD'
+				    '-'
+				    ).
+	    fileSelectors :=    #(
+				    methodFileOut
+				    methodPrintOut
+				    nil
+				    methodSpawn
+				    nil
+				 ).
+	    sepLocalLabels := #('-'). sepLocalSelectors := #(nil).
+	    mthdLabels :=           #(
+				    'change category ...'
+				    'remove'
+				    ).
+	    mthdSelectors :=    #(
+				    methodChangeCategory
+				    methodRemove
+				 ).
+	    currentMethod isWrapped ifTrue:[
+		brkLabels := #(
+				    'remove break/trace'
+				    '-'
+			      ).
+		brkSelectors := #(
+				    methodRemoveBreakOrTrace
+				    nil
+				 )
+	    ] ifFalse:[
+		brkLabels := #(
+				    'breakpoint'
+				    'trace'
+				    'trace sender'
+				    '-'
+			      ).
+		brkSelectors := #(
+				    methodBreakPoint
+				    methodTrace
+				    methodTraceSender
+				    nil
+				 )
+	    ]
+	] ifFalse:[
+	    fileLabels := fileSelectors := #().
+	    brkLabels := brkSelectors := #().
+	    mthdLabels := mthdSelectors := #().
+	].
+	labels :=
+		    fileLabels ,
+		    searchLabels ,
+		    localSearchLabels ,
+		    sepLocalLabels ,
+		    brkLabels ,
+		    newLabels ,
+		    mthdLabels.
+	selectors :=
+		    fileSelectors ,
+		    searchSelectors ,
+		    localSearchSelectors ,
+		    sepLocalSelectors ,
+		    brkSelectors ,
+		    newSelectors ,
+		    mthdSelectors.
+"
+	labels := #(
+				    'fileOut'
+				    'printOut'
+				    '-'
+				    'SPAWN_METHOD'
+				    '-'
+				    'senders ...'
+				    'implementors ...'
+				    'globals ...'
+				    'string search ...'
+				    'apropos ...'
+				    '-'
+				    'local senders ...'
+				    'local implementors ...'
+				    'local string search ...'
+				    'local apropos ...'
+				    '-'
+				    'breakpoint'
+				    'trace'
+				    'trace sender'
+				    '-'
+				    'new method'
+				    'change category ...'
+				    'remove'
+				).
+	 selectors := #(
+				    methodFileOut
+				    methodPrintOut
+				    nil
+				    methodSpawn
+				    nil
+				    methodSenders
+				    methodImplementors
+				    methodGlobalReferends
+				    methodStringSearch
+				    methodAproposSearch
+				    nil
+				    methodLocalSenders
+				    methodLocalImplementors
+				    methodLocalStringSearch
+				    methodLocalAproposSearch
+				    nil
+				    methodBreakPoint
+				    methodTrace
+				    methodTraceSender
+				    nil
+				    methodNewMethod
+				    methodChangeCategory
+				    methodRemove
+				  )
+"
+].
+m := PopUpMenu
+	 labels:(resources array:labels)
+	 selectors:selectors.
+currentMethod notNil ifTrue:[
+	currentMethod isPrivate ifTrue:[
+	    m disable:#methodMakePrivate
+	].
+	currentMethod isProtected ifTrue:[
+	    m disable:#methodMakeProtected
+	].
+	currentMethod isPublic ifTrue:[
+	    m disable:#methodMakePublic
+	].
+].
+currentMethod notNil ifTrue:[
+	(currentMethod code notNil
+	or:[Compiler canCreateMachineCode not]) ifTrue:[
+	    m disable:#methodSTCCompile
+	].
+	currentMethod byteCode isNil ifTrue:[
+	    m disable:#methodDecompile
+	].
+].
+^ m
+"Created: 23.11.1995 / 12:02:29 / cg"
+!!
+methodNewMethod
+"prepare for definition of a new method - put a template into
+code view and define accept-action to compile it"
+currentClass isNil ifTrue:[
+	^ self warn:'select/create a class first'.
+].
+currentMethodCategory isNil ifTrue:[
+	^ self warn:'select/create a method category first'.
+].
+currentMethod := currentSelector := nil.
+methodListView deselect.
+codeView contents:(self template).
+codeView modified:false.
+self setAcceptAndExplainActionsForMethod.
+!!
+methodPrintOut
+"print out the current method"
+|printStream|
+self checkMethodSelected ifFalse:[^ self].
+printStream := Printer new.
+actualClass printOutSource:(currentMethod source) on:printStream.
+printStream close
+!!
+methodPrivacy:how
+"change the current methods privacy.
+EXPERIMENTAL"
+self checkMethodSelected ifFalse:[^ self].
+currentMethod isPublic ifFalse:[
+	currentMethod privacy:how.
+	actualClass updateRevisionString.
+	actualClass addChangeRecordForMethodPrivacy:currentMethod.
+	self updateMethodListWithScroll:false keepSelection:true.
+]
+"Created: 29.10.1995 / 20:00:00 / cg"
+!!
+methodRemove
+"remove the current method"
+self checkMethodSelected ifFalse:[^ self].
+actualClass removeSelector:(actualClass selectorAtMethod:currentMethod).
+currentMethod := currentSelector := nil.
+self updateMethodListWithScroll:false
+!!
+methodRemoveBreakOrTrace
+"turn off tracing of the current method"
+(currentMethod notNil and:[currentMethod isWrapped]) ifTrue:[
+	self commonTraceHelperWith:#unwrapMethod:
+]
+!!
+methodSTCCompile
+"compile the current method to machine code.
+This is not supported on all machines, and never supported in
+the demo version."
+|prev|
+self checkMethodSelected ifFalse:[^ self].
+prev := Compiler stcCompilation:#always.
+[
+	codeView accept.
+] valueNowOrOnUnwindDo:[
+	Compiler stcCompilation:prev
+].
+!!
+methodSenders
+"launch an enterBox for selector to search for"
+self askForSelectorTitle:'selector to browse senders of:'
+		    openWith:#browseAllCallsOn:
+!!
+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 isMeta w|
+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:[
+			    SystemBrowser 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.
+	SystemBrowser browseClass:(w at:1) selector:(w at:2)
+]
+!!
+methodStringSearch
+"launch an enterBox for string to search for"
+self askForSelectorTitle:'string to search for in sources:'
+		    openWith:#browseForString:
+!!
+methodTrace
+"turn on tracing of the current method"
+currentClass notNil ifTrue:[
+currentSelector notNil ifTrue:[
+	  currentMethod := actualClass compiledMethodAt:currentSelector
+]
+].
+(currentMethod notNil and:[currentMethod isWrapped not]) ifTrue:[
+	self commonTraceHelperWith:#traceMethod:
+]
+!!
+methodTraceSender
+"turn on tracing of the current method"
+(currentMethod notNil and:[currentMethod isWrapped not]) ifTrue:[
+	self commonTraceHelperWith:#traceMethodSender:
+]
+!! !!
+!!BrowserView methodsFor:'method stuff'!!
+checkMethodSelected
+currentMethod isNil ifTrue:[
+	self warn:'select a method first'.
+	^ false
+].
+^ true
+!!
+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|
+newList := Set new.
+self classesInFullProtocolHierarchy:aClass do:[:c |
+	|searchCategory|
+	(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
+!!
+listOfAllSelectorsInCategory:aCategory ofClass:aClass
+"answer a list of all selectors in a given method category
+of the argument, aClass"
+|newList searchCategory all p|
+all := (aCategory = '* all *').
+(aCategory = '* no category *') ifTrue:[
+	searchCategory := nil
+] ifFalse:[
+	searchCategory := aCategory
+].
+newList := OrderedCollection new.
+aClass methodArray with:aClass selectorArray do:[:aMethod :selector |
+	|sel how|
+	(all or:[aMethod category = searchCategory]) ifTrue:[
+	    sel := selector.
+	    (p := aMethod privacy) ~~ #public ifTrue:[
+		how := '    (* ' , p , ' *)'.
+	    ].
+	    aMethod isWrapped ifTrue:[
+		how := ' !!!!'
+	    ].
+	    aMethod isInvalid ifTrue:[
+		how := '    (** not executable **)'
+	    ].
+	    aMethod isLazyMethod ifTrue:[
+"/                how := '    (lazy)'
+	    ] ifFalse:[
+		(aMethod code isNil
+		and:[aMethod byteCode isNil]) ifTrue:[
+		    how := '    (** unloaded **)'
+		]
+	    ].
+	    how notNil ifTrue:[sel := sel , how].
+	    newList add:sel
+	]
+].
+(newList size == 0) ifTrue:[^ nil].
+^ newList sort
+"Modified: 28.8.1995 / 21:53:34 / claus"
+!!
+methodSelection:lineNr
+"user clicked on a method line - show code"
+|selectorString selectorSymbol|
+(fullProtocol not and:[currentClass isNil]) ifTrue:[^ self].
+selectorString := methodListView selectionValue.
+"
+kludge: extract real selector
+"
+selectorString := selectorString withoutSpaces upTo:(Character space).
+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.
+		acceptClass := c
+	    ]
+	]
+] 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
+!!
+methodSelectionChanged
+"method selection has changed - update dependent views"
+self withWaitCursorDo:[
+	|index cls|
+	self updateCodeView.
+	aspect := nil.
+	self setAcceptAndExplainActionsForMethod.
+	"
+	 if there is any autoSearch string, do the search
+	"
+	autoSearch notNil ifTrue:[
+	    codeView searchFwd:autoSearch startingAtLine:1 col:0 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
+		 and:[cls isMeta
+		 and:[cls name endsWith:'class']]) ifTrue:[
+		    index := classListView list indexOf:(cls name copyWithoutLast:5).
+		].
+		index ~~ 0 ifTrue:[
+		    classListView attributeAt:index add:#bold.
+		].
+		currentClass := acceptClass := cls.
+	    ]
+	].
+]
+"Created: 23.11.1995 / 14:17:44 / cg"
+!!
+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 whichClassIncludesSelector:aSelector.
+	aClass notNil ifTrue:[
+	    nm := aClass name.
+	    showInstance ifFalse:[
+		((nm ~= 'Metaclass') and:[nm endsWith:'class']) ifTrue:[
+		    nm := nm copyWithoutLast:5 "copyTo:(nm size - 5)"
+		]
+	    ].
+	    self switchToClassNamed:nm.
+	    self switchToMethodNamed:aString
+	]
+]
+!!
+switchToMethodNamed:matchString
+"switch (in the current class) to a method named matchString.
+If there are more than one matches, switch to the first."
+|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 updateMethodCategoryListWithScroll:false.
+	    self methodCategorySelectionChanged.
+	    currentMethod := classToSearch compiledMethodAt:aSelector.
+	    currentMethod notNil ifTrue:[
+		currentSelector := aSelector.
+		methodListView selectElement:aSelector.
+	    ].
+	    self methodSelectionChanged
+	]
+]
+!!
+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''.
+"
+'
+!!
+updateMethodList
+self updateMethodListWithScroll:true keepSelection:false
+!!
+updateMethodListWithScroll:scroll
+self updateMethodListWithScroll:scroll keepSelection:false
+!!
+updateMethodListWithScroll:scroll keepSelection:keep
+|selectors scr first last selection|
+methodListView notNil ifTrue:[
+	selection := methodListView selection.
+	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
+	    ]
+	].
+	keep ifTrue:[
+	    methodListView selection:selection.
+	]
+]
+!! !!
+!!BrowserView methodsFor:'misc'!!
+instanceProtocol:aBoolean
+"switch between instance and class protocol"
+|onToggle offToggle|
+showInstance ~~ aBoolean ifTrue:[
+	self checkSelectionChangeAllowed ifTrue:[
+	    instanceToggle notNil ifTrue:[
+		aBoolean ifTrue:[
+		    offToggle := classToggle.
+		    onToggle := instanceToggle.
+		] ifFalse:[
+		    onToggle := classToggle.
+		    offToggle := instanceToggle.
+		].
+		onToggle turnOn.
+		offToggle turnOff.
+	    ].
+	    showInstance := aBoolean.
+	    (variableListView notNil
+	    and:[variableListView hasSelection]) ifTrue:[
+		self unhilightMethodCategories.
+		self unhilightMethods.
+		variableListView deselect
+	    ].
+	    fullProtocol ifTrue:[
+		showInstance ifTrue:[
+		    actualClass := currentClassHierarchy.
+		] ifFalse:[
+		    actualClass := currentClassHierarchy class.
+		].
+		acceptClass := actualClass.
+		self updateClassList.
+		self updateMethodCategoryListWithScroll:false.
+		self updateMethodListWithScroll:false.
+		self updateVariableList.
+		^ self
+	    ].
+	    currentClass notNil ifTrue:[
+		self classSelectionChanged
+	    ].
+	    codeView modified:false.
+	] ifFalse:[
+	    aBoolean ifTrue:[
+		onToggle := classToggle.
+		offToggle := instanceToggle
+	    ] ifFalse:[
+		offToggle := classToggle.
+		onToggle := instanceToggle.
+	    ].
+	    onToggle turnOn.
+	    offToggle turnOff.
+	]
+]
+!!
+processName
+"the name of my process - for the processMonitor only"
+^ 'System Browser'.
+!!
+updateCodeView
+|code|
+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.
+"Created: 23.11.1995 / 14:16:43 / cg"
+"Modified: 23.11.1995 / 14:19:25 / cg"
+!! !!
+!!BrowserView methodsFor:'private'!!
+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
+!!
+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
+!!
+askForSelectorTitle:title
+"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 | aString isEmpty ifTrue:[^ nil]. ^ aString].
+box showAtPointer.
+^ nil
+!!
+askForSelectorTitle:title openWith:selector
+"convenient method: setup enterBox with text from codeView or selected
+method for browsing based on a selector. Set action and launch box"
+|string|
+string := self askForSelectorTitle:title.
+string notNil ifTrue:[
+	self withSearchCursorDo:[
+	    SystemBrowser perform:selector with:string
+	]
+].
+"Created: 23.11.1995 / 14:11:34 / cg"
+!!
+askForSelectorTitle:title openWith:selector and:arg
+"convenient method: setup enterBox with text from codeView or selected
+method for browsing based on a selector. Set action and launch box"
+|string|
+string := self askForSelectorTitle:title.
+string notNil ifTrue:[
+	self withSearchCursorDo:[
+	    SystemBrowser perform:selector with:string with:arg
+	]
+].
+"Created: 23.11.1995 / 14:11:38 / cg"
+!!
+busyLabel:what with:someArgument
+"set the title for some warning"
+self label:('System Browser - ' , (resources string:what with:someArgument))
+!!
+checkSelectionChangeAllowedWithCompare:compareOffered
+"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"
+|action labels values|
+codeView modified ifFalse:[
+	^ true
+].
+compareOffered ifTrue:[
+	labels := #('abort' 'compare' 'accept' 'continue').
+	values := #(false #compare #accept true).
+] ifFalse:[
+	labels := #('abort' 'accept' 'continue').
+	values := #(false #accept true).
+].
+action := OptionBox
+		  request:(resources at:'text has not been accepted.\\Your modifications will be lost when continuing.') withCRs
+		  label:(resources string:'Attention')
+		  form:(WarningBox iconBitmap)
+		  buttonLabels:(resources array:labels)
+		  values:values
+		  default:true.
+action ~~ #accept ifTrue:[
+	^ action
+].
+codeView accept.
+^ true
+"Created: 24.11.1995 / 10:54:46 / cg"
+!!
+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"
+|what m src v|
+currentMethod notNil ifTrue:[
+	m := actualClass compiledMethodAt:currentSelector.
+	m notNil ifTrue:[
+	    (src := m source) = codeView contents ifFalse:[
+		what := self checkSelectionChangeAllowedWithCompare:true.
+		what == #compare ifTrue:[
+		    v := DiffTextView
+			    openOn:codeView contents label:'code here (to be accepted ?)'
+			    and:src label:'methods actual code'.
+		    v label:'comparing method versions'.
+		    ^ false
+		].
+		^ what
+	    ]
+	]
+].
+^ self checkSelectionChangeAllowedWithCompare:false
+"Created: 24.11.1995 / 11:03:33 / cg"
+"Modified: 24.11.1995 / 11:05:49 / cg"
+!!
+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
+	]
+]
+!!
+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
+]
+!!
+classesInHierarchy:aClass do:aBlock
+|index|
+index := (classListView list size).
+aClass withAllSuperclasses do:[:c |
+	(classListView isInSelection:index) ifFalse:[
+	    aBlock value:c
+	].
+	index := index - 1
+]
+!!
+compileCode:someCode
+(ReadStream on:someCode) fileIn
+!!
+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 |
+	aString notEmpty ifTrue:[
+	    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
+!!
+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
+!!
+enterBoxTitle:title okText:okText
+"convenient method: setup enterBox"
+|box|
+box := EnterBox new.
+box title:(resources string:title) okText:(resources string:okText).
+^ box
+!!
+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 copyWithoutLast:5 "copyTo:(clsName size - 5)"
+	    ] ifFalse:[
+		isMeta := false
+	    ].
+	]
+].
+aBlock value:clsName value:sel value:isMeta
+!!
+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
+!!
+listBoxForCodeSelectionTitle:title okText:okText
+"convenient method: setup listBox with text from codeview"
+|sel box|
+box := self listBoxTitle:title okText:okText list:nil.
+sel := codeView selection.
+sel notNil ifTrue:[
+	box initialText:(sel asString withoutSeparators)
+].
+^ box
+!!
+listBoxTitle:title okText:okText list:aList
+"convenient method: setup a listBox & return it"
+|box|
+box := ListSelectionBox
+		title:(resources string:title)
+		okText:(resources string:okText)
+		action:nil.
+box list:aList.
+^ box
+!!
+normalLabel
+"set the normal (inactive) window- and icon labels"
+|l il|
+myLabel notNil ifTrue:[
+	"if I have been given an explicit label,
+	 and its not the default, take that one"
+	myLabel ~= 'System Browser' ifTrue:[
+	    l := il := myLabel
+	]
+].
+l isNil ifTrue:[
+	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.
+!!
+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 upTo:(Character space)
+	] ifFalse:[
+	    sel := ''
+	]
+].
+^ sel
+!!
+setAcceptAndExplainActionsForMethod
+"tell the codeView what to do on accept and explain"
+codeView acceptAction:[:theCode |
+	|cat cls|
+	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:[
+	    fullProtocol ifTrue:[
+		cls := acceptClass "/actualClass whichClassIncludesSelector:currentSelector.
+	    ].
+	    cls isNil ifTrue:[
+		cls := actualClass
+	    ].
+	    Object abortSignal catch:[
+		lockUpdates := true.
+		actualClass compilerClass
+		    compile:theCode asString
+		    forClass:cls
+		    inCategory:cat
+		    notifying:codeView.
+		codeView modified:false.
+		self updateMethodListWithScroll:false.
+		currentMethod := actualClass compiledMethodAt:currentSelector.
+	    ].
+	    lockUpdates := false.
+	].
+	codeView cursor:Cursor normal.
+].
+codeView explainAction:[:theCode :theSelection |
+	self showExplanation:(Explainer
+				explain:theSelection
+				in:theCode
+				forClass:actualClass)
+].
+!!
+setDoitActionForClass
+"tell the codeView what to do on doIt"
+"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 evaluatorClass
+	].
+	compiler
+	    evaluate:theCode
+	    in:nil
+	    receiver:currentClass
+	    notifying:codeView
+	    logged:false
+	    ifFail:nil
+].
+!!
+setSearchPattern:aString
+codeView setSearchPattern:aString
+!!
+showExplanation:someText
+"show explanation from Parser"
+self information: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
+!!
+warnLabel:what
+"set the title for some warning"
+self label:('System Browser WARNING: ' , what)
+!!
+withSearchCursorDo:aBlock
+^ self withCursor:(Cursor questionMark) do:aBlock
+"Created: 23.11.1995 / 14:11:14 / cg"
+!! !!
+!!BrowserView methodsFor:'unused'!!
+listOfAllMethodCategoriesInHierarchy:aClass
+"answer a list of all method categories of the argument, aClass,
+and all of its superclasses"
+|newList cat|
+newList := Set new.
+self classesInHierarchy:aClass do:[:c |
+	c methodArray do:[:aMethod |
+	    cat := aMethod category.
+	    cat isNil ifTrue:[
+		cat := '* no category *'
+	    ].
+	    newList add:cat
+	]
+].
+(newList size == 0) ifTrue:[^ nil].
+newList add:'* all *'.
+^ newList asOrderedCollection sort
+!!
+listOfAllSelectorsInCategory:aCategory inHierarchyOfClass:aClass
+"answer a list of all selectors in a given method category
+of the argument, aClass and its superclasses"
+|newList|
+newList := Set new.
+self classesInHierarchy:aClass do:[:c |
+	|searchCategory|
+	(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
+!! !!
+!!BrowserView methodsFor:'variable list menu'!!
+allClassOrInstVarRefsTitle:title access:access mods:modifications
+"show an enterbox for instVar to search for"
+self doClassMenu:[:currentClass |
+	|box|
+	box := self enterBoxForVariableSearch:title.
+	box action:[:aVariableName |
+	    |homeClass|
+	    aVariableName isEmpty ifFalse:[
+		self withSearchCursorDo:[
+		    homeClass := self findClassOfVariable:aVariableName accessWith:access.
+		    access == #classVarNames ifTrue:[
+			SystemBrowser
+			    browseClassRefsTo:aVariableName
+			    under:homeClass
+			    modificationsOnly:modifications
+		    ] ifFalse:[
+			SystemBrowser
+			    browseInstRefsTo:aVariableName
+			    under:homeClass
+			    modificationsOnly:modifications
+		    ]
+		]
+	    ]
+	].
+	box showAtPointer
+]
+"Created: 23.11.1995 / 14:13:24 / cg"
+!!
+allClassVarMods
+"show an enterbox for classVar to search for"
+self allClassOrInstVarRefsTitle:'class variable to browse modifications of:'
+				  access:#classVarNames
+				  mods:true
+!!
+allClassVarRefs
+"show an enterbox for classVar to search for"
+self allClassOrInstVarRefsTitle:'class variable to browse references to:'
+				  access:#classVarNames
+				  mods:false
+!!
+allInstVarMods
+"show an enterbox for instVar to search for"
+self allClassOrInstVarRefsTitle:'instance variable to browse modifications of:'
+				  access:#instVarNames
+				  mods:true
+!!
+allInstVarRefs
+"show an enterbox for instVar to search for"
+self allClassOrInstVarRefsTitle:'instance variable to browse references to:'
+				  access:#instVarNames
+				  mods:false
+!!
+classVarMods
+"show an enterbox for classVar to search for"
+self classVarRefsOrModsTitle:'class variable to browse modifications of:'
+				 mods:true
+!!
+classVarRefs
+"show an enterbox for classVar to search for"
+self classVarRefsOrModsTitle:'class variable to browse references to:'
+				 mods:false
+!!
+classVarRefsOrModsTitle:title mods:mods
+"show an enterbox for classVar to search for"
+self doClassMenu:[:currentClass |
+	|box|
+	box := self enterBoxForVariableSearch:title.
+	box action:[:aString |
+	    aString notEmpty ifTrue:[
+		self withSearchCursorDo:[
+		    SystemBrowser
+			   browseClassRefsTo:aString
+			   in:(Array with:currentClass)
+			   modificationsOnly:mods
+		]
+	    ]
+	].
+	box showAtPointer
+]
+"Created: 23.11.1995 / 14:12:56 / cg"
+!!
+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
+!!
+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
+!!
+instVarRefsOrModsTitle:title mods:mods
+"show an enterbox for instvar to search for"
+self doClassMenu:[:currentClass |
+	|box|
+	box := self enterBoxForVariableSearch:title.
+	box action:[:aString |
+	    aString notEmpty ifTrue:[
+		self withSearchCursorDo:[
+		    SystemBrowser
+			browseInstRefsTo:aString
+			in:(Array with:currentClass)
+			modificationsOnly:mods
+		]
+	    ]
+	].
+	box showAtPointer
+]
+"Created: 23.11.1995 / 14:12:40 / cg"
+!!
+varTypeInfo
+"show typical usage of a variable"
+|name idx classes values value msg cut names instCount subInstCount box
+searchClass|
+name := variableListView selectionValue.
+name isNil ifTrue:[^ self].
+searchClass := actualClass whichClassDefinesInstVar:name.
+idx := searchClass instVarOffsetOf:name.
+idx isNil ifTrue:[^ self].
+classes := IdentitySet new.
+values := IdentitySet new.
+instCount := 0.
+subInstCount := 0.
+searchClass allSubInstancesDo:[:i |
+	|val|
+	val := i instVarAt:idx.
+	val notNil ifTrue:[values add:val].
+	classes add:val class.
+	(i isMemberOf:searchClass) ifTrue:[
+	    instCount := instCount + 1.
+	] ifFalse:[
+	    subInstCount := subInstCount + 1
+	]
+].
+(instCount == 0 and:[subInstCount == 0]) ifTrue:[
+	self warn:'there are currently no instances of ' , currentClass name.
+	^ self
+].
+instCount ~~ 0 ifTrue:[
+	msg := 'in (currently: ' , instCount printString,') instances '.
+	subInstCount ~~ 0 ifTrue:[
+	    msg := msg , 'and '
+	]
+] ifFalse:[
+	msg := 'in '.
+].
+subInstCount ~~ 0 ifTrue:[
+	msg := msg , '(currently: ' , subInstCount printString, ') derived instances '
+].
+msg := msg, 'of ' , searchClass name , ',\'.
+msg := msg , name , ' '.
+((values size == 1)
+or:[classes size == 1 and:[classes first == UndefinedObject]]) ifTrue:[
+	values size == 1 ifTrue:[value := values first].
+	(value isNumber or:[value isString]) ifTrue:[
+	    msg := msg , 'is always the same:\\      ' ,
+			 value class name , ' (' , value storeString , ')'.
+	] ifFalse:[
+	    (value isNil or:[value == true or:[value == false]]) ifTrue:[
+		msg := msg , 'is always:\\      ' ,
+			     value printString.
+	    ] ifFalse:[
+		msg := msg , 'is always the same:\\'.
+		msg := msg , '      ' , value class name.
+		value isLiteral ifTrue:[
+		    msg := msg , ' (' , value storeString , ')'
+		]
+	    ]
+	]
+] ifFalse:[
+	classes size == 1 ifTrue:[
+	    msg := msg , 'is always:\\'.
+	    msg := msg , '      ' , classes first name , '\'.
+	] ifFalse:[
+	    msg := msg , 'is one of:\\'.
+	    classes := classes asOrderedCollection.
+	    classes size > 20 ifTrue:[
+		classes := classes copyFrom:1 to:20.
+		cut := true
+	    ] ifFalse:[
+		cut := false.
+	    ].
+	    names := classes collect:[:cls |
+		|nm|
+		cls == UndefinedObject ifTrue:[
+		    'nil'
+		] ifFalse:[
+		    cls == True ifTrue:[
+			'true'
+		    ] ifFalse:[
+			cls == False ifTrue:[
+			    'false'
+			] ifFalse:[
+			    cls name
+			]
+		    ]
+		].
+	    ].
+	    names sort.
+	    names do:[:nm |
+		msg := msg , '      ' , nm , '\'.
+	    ].
+	]
+].
+box := InfoBox title:msg withCRs.
+box label:'variable type information'.
+box showAtPointer
+!!
+variableListMenu
+|labels selectors|
+currentClass isNil ifTrue:[
+	variableListView flash.
+	^ nil
+].
+labels := #(
+		    '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
+		 ).
+(showInstance and:[variableListView hasSelection]) ifTrue:[
+	labels := labels , #(
+				'-'
+				'type information'
+			   ).
+	selectors := selectors , #(
+				nil
+				varTypeInfo
+				).
+].
+^ PopUpMenu labels:(resources array:labels)
+		selectors:selectors
+!!
+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.
+!! !!
+!!BrowserView methodsFor:'variable stuff'!!
+hilightMethodsInMethodCategoryList
+"search for methods  which access the selected
+variable, and highlight them"
+self hilightMethodsInMethodCategoryList:true inMethodList:false
+!!
+hilightMethodsInMethodCategoryList:inCat inMethodList:inMethods
+"search for methods  which access the selected
+variable, and highlight them"
+|name 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 withSearchCursorDo:[
+	|classes filter any|
+	classes := Array with:actualClass.
+	currentClassHierarchy notNil ifTrue:[
+	    classes := classes , actualClass allSuperclasses.
+	    redefinedSelectors := IdentitySet new.
+	].
+	filter := SystemBrowser filterToSearchRefsTo:name classVars:showInstance not modificationsOnly:false.
+	any := false.
+	"
+	 highlight the method that ref this variable
+	"
+	classes do:[:someClass |
+	    (fullProtocol
+	    and:[classListView valueIsInSelection:(someClass name)]) ifFalse:[
+		someClass methodArray with:someClass selectorArray
+		do:[:method :selector |
+		    (inCat
+		    or:[methodListView list notNil
+			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
+	]
+]
+"Created: 23.11.1995 / 14:12:08 / cg"
+!!
+hilightMethodsInMethodList
+"search for methods  which access the selected
+variable, and highlight them"
+self hilightMethodsInMethodCategoryList:false inMethodList:true
+!!
+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.
+	]
+].
+!!
+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.
+	].
+].
+!!
+updateVariableList
+|l subList last nameAccessSelector class oldSelection|
+variableListView isNil ifTrue:[^ self].
+oldSelection := variableListView selectionValue.
+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 := currentClassHierarchy notNil ifTrue:[currentClassHierarchy] ifFalse:[currentClass].
+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.
+	self hilightMethodsInMethodCategoryList:true inMethodList:true.
+]
+!! !!
+!!BrowserView class methodsFor:'documentation'!!
+version
+^ '$Header: /cvs/stx/stx/libtool/BrowserView.st,v 1.58 1995-12-07 12:26:14 cg Exp $'!! !!
+BrowserView initialize!!
+!
+classPrintOut
+self classPrintOutWith:#printOutOn:
+!
+classPrintOutFullProtocol
+self classPrintOutWith:#printOutFullProtocolOn:
+!
+classPrintOutProtocol
+self classPrintOutWith:#printOutProtocolOn:
+!
+classPrintOutWith:aSelector
+self doClassMenu:[:currentClass |
+	|printStream|
+	printStream := Printer new.
+	currentClass perform:aSelector with:printStream.
+	printStream close
+]
+!
+classProtocols
+^ self
+!
+classRefs
+self doClassMenu:[:currentClass |
+	self withSearchCursorDo:[
+	    SystemBrowser browseReferendsOf:currentClass name asSymbol
+	]
+]
+"Created: 23.11.1995 / 14:11:43 / cg"
+!
+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 %1'.
+	count ~~ 0 ifTrue:[
+	   t := t , '\(with %2 subclass'.
+	   count ~~ 1 ifTrue:[
+		t := t , 'es'
+	   ].
+	   t := (t , ')')
+	].
+	t := t , ' ?'.
+	t := (resources string:t with:currentClass name with:count) 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 |
+		|didRemove|
+		didRemove := false.
+		"
+		 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:[
+			didRemove := true.
+			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
+		].
+"
+		didRemove ifTrue:[
+		    methodCategoryListView notNil ifTrue:[methodCategoryListView contents:nil].
+		    methodListView notNil ifTrue:[methodListView contents:nil].
+		    codeView contents:nil.
+		    codeView modified: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
+!
+classShowFrom:getSelector set:setSelector aspect:aspectSymbol default:default
+"common helper for comment, primitive-stuff etc.
+show the string returned from the classes getSelector-method,
+Set acceptaction to change it via setSelector."
+self doClassMenu:[:currentClass |
+	|text|
+	text := currentClass perform:getSelector.
+	text isNil ifTrue:[
+	    text := default
+	].
+	codeView contents:text.
+	codeView modified:false.
+	codeView acceptAction:[:theCode |
+	    Object abortSignal catch:[
+		lockUpdates := true.
+		currentClass perform:setSelector with:theCode asString.
+		codeView modified:false.
+	    ].
+	    lockUpdates := false.
+	].
+	codeView explainAction:nil.
+	methodListView notNil ifTrue:[
+	    methodListView deselect
+	].
+	aspect := aspectSymbol.
+	self normalLabel
+]
+!
+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."
+self doClassMenuWithSelection:[:cls :sel |
+	|browser|
+	cls isMeta ifTrue:[
+	    Smalltalk allBehaviorsDo:[:aClass |
+		aClass class == cls ifTrue:[
+		    browser := SystemBrowser browseClass:aClass.
+		    browser instanceProtocol:false.
+		    sel notNil ifTrue:[
+			browser switchToMethodNamed:sel
+		    ].
+		    ^ self
+		].
+	    ].
+	    self warn:'oops, no class for this metaclass'.
+	    ^ self
+	].
+	browser := SystemBrowser browseClass:cls.
+	cls hasMethods ifFalse:[
+	    browser instanceProtocol:false.
+	].
+	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
+"
+!
+classSpawnFullProtocol
+"create a new browser, browsing current classes full protocol"
+self doClassMenuWithSelection:[:cls :sel |
+	SystemBrowser browseFullClassProtocol:cls
+]
+!
+classSpawnHierarchy
+"create a new HierarchyBrowser browsing current class"
+self doClassMenuWithSelection:[:cls :sel |
+	SystemBrowser browseClassHierarchy:cls
+]
+!
+classSpawnSubclasses
+"create a new browser browsing current class's subclasses"
+self doClassMenuWithSelection:[:cls :sel |
+	|subs|
+	subs := cls allSubclasses.
+	(subs notNil and:[subs size ~~ 0]) ifTrue:[
+	    SystemBrowser browseClasses:subs title:('subclasses of ' , cls name)
+	]
+]
+!
+classUnload
+"unload an autoloaded class"
+|nm|
+self checkClassSelected ifFalse:[^ self].
+nm := currentClass name.
+currentClass unload.
+self switchToClassNamed:nm
+!
+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:[:currentClass |
+	self withSearchCursorDo:[
+	    SystemBrowser browseUsesOf:currentClass
+	]
+]
+"Created: 23.11.1995 / 14:11:47 / cg"
+!
+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|
+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 copyWithoutLast:5 "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:[:currentClass | aBlock value:currentClass value:sel]
 ! !
+!BrowserView methodsFor:'class list source administration'!
+classCheckin
+"check a class into the source repository"
+self doClassMenu:[:currentClass |
+|logMessage info mgr|
+mgr := (currentClass sourceCodeManager).
+(info := mgr sourceInfoOfClass:currentClass) isNil ifTrue:[
+^ self classCreateSourceContainerFor:currentClass
+].
+logMessage := Dialog
+request:'enter a log message:'
+initialAnswer:lastSourceLogMessage
+onCancel:nil.
+logMessage notNil ifTrue:[
+lastSourceLogMessage := logMessage.
+self busyLabel:'checking in %1' with:currentClass name.
+(mgr checkinClass:currentClass logMessage:logMessage) ifFalse:[
+self warn:'checkin failed'.
+].
+aspect == #revisionInfo ifTrue:[
+self classListUpdate
+].
+self normalLabel.
+]
+]
+"Created: 23.11.1995 / 11:41:38 / cg"
+"Modified: 7.12.1995 / 13:17:43 / cg"
+!
+classCompareWithNewestInRepository
+"open a diff-textView comparing the current (in-image) version
+with the most recent version found in the repository."
+self doClassMenu:[:currentClass |
+|aStream comparedSource currentSource v rev revString mgr|
+mgr := currentClass sourceCodeManager.
+rev := Dialog request:'compare to revision: (empty for newest)'.
+rev notNil ifTrue:[
+rev withoutSpaces isEmpty ifTrue:[
+self busyLabel:'extracting newest %1' with:currentClass name.
+aStream := mgr mostRecentSourceStreamForClassNamed:currentClass name.
+revString := 'newest'
+] ifFalse:[
+self busyLabel:'extracting previous %1' with:currentClass name.
+aStream := mgr sourceStreamFor:currentClass revision:rev.
+revString := rev
+].
+comparedSource := aStream contents.
+aStream close.
+self busyLabel:'generating current source ...' with:nil.
+aStream := '' writeStream.
+currentClass fileOutOn:aStream withTimeStamp:false.
+currentSource := aStream contents.
+aStream close.
+self busyLabel:'comparing  ...' with:nil.
+v := DiffTextView
+openOn:currentSource label:'current (' , currentClass revision , ')'
+and:comparedSource label:'repository (' , revString , ')'.
+v label:'comparing ' , currentClass name.
+self normalLabel.
+]
+]
+"Created: 14.11.1995 / 16:43:15 / cg"
+"Modified: 7.12.1995 / 13:18:12 / cg"
+!
+classCreateSourceContainerFor:aClass
+"let user specify the source-repository values for aClass"
+|box
+moduleDirectory subDirectory
+fileName specialFlags
+check y component info fn project|
+moduleDirectory := 'stx' asValue.
+subDirectory := '' asValue.
+(Project notNil and:[(project := Project current) notNil]) ifTrue:[
+subDirectory value:(project name)
+].
+info := (aClass sourceCodeManager) sourceInfoOfClass:aClass.
+info notNil ifTrue:[
+(info includesKey:#module) ifTrue:[
+moduleDirectory value:(info at:#module).
+].
+(info includesKey:#directory) ifTrue:[
+subDirectory value:(info at:#directory).
+].
+(info includesKey:#expectedFileName) ifTrue:[
+fn := (info at:#expectedFileName).
+] ifFalse:[
+(info includesKey:#classFileName) ifTrue:[
+fn := (info at:#classFileName).
+]
+]
+].
+fn isNil ifTrue:[
+fn := (Smalltalk fileNameForClass:aClass) , '.st'.
+].
+"/
+"/ should check for conflicts ...
+"/
+fileName := fn asValue.
+box := DialogBox new.
+box label:(resources string:'Repository information for %1' with:aClass name).
+component := box addTextLabel:(resources string:'CREATE_REPOSITORY' with:currentClass name) withCRs.
+component adjust:#left; borderWidth:0.
+y := box yPosition.
+component := box addTextLabel:(resources string:'Module:').
+component width:0.5; adjust:#right.
+box yPosition:y.
+component := box addInputFieldOn:moduleDirectory tabable:true.
+component width:0.5; left:0.5; immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine.
+box addVerticalSpace.
+y := box yPosition.
+component := box addTextLabel:'Package:'.
+component width:0.5; adjust:#right.
+box yPosition:y.
+component := box addInputFieldOn:subDirectory tabable:true.
+component width:0.5; left:0.5; immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine.
+box addVerticalSpace.
+y := box yPosition.
+component := box addTextLabel:'Filename:'.
+component width:0.5; adjust:#right.
+box yPosition:y.
+component := box addInputFieldOn:fileName tabable:true.
+component width:0.5; left:0.5; immediateAccept:true; acceptOnLeave:false; cursorMovementWhenUpdating:#beginOfLine.
+box addVerticalSpace.
+box addVerticalSpace.
+box addAbortButton; addOkButton.
+box showAtPointer.
+box accepted ifTrue:[
+self halt.
+]
+"Modified: 7.12.1995 / 13:18:37 / cg"
+!
+classLoadRevision
+"load a specific revision into the system - especially useful to
+upgrade a class to the newest revision"
+self doClassMenu:[:currentClass |
+|aStream comparedSource currentSource v rev revString what mgr|
+mgr := currentClass sourceCodeManager.
+rev := Dialog request:'load which revision: (empty for newest)'.
+rev notNil ifTrue:[
+rev withoutSpaces isEmpty ifTrue:[
+what := currentClass name , '(newest)'.
+self busyLabel:'extracting %1' with:what.
+aStream := mgr mostRecentSourceStreamForClassNamed:currentClass name.
+revString := 'newest'
+] ifFalse:[
+what := currentClass name , '(' , rev , ')'.
+self busyLabel:'extracting %1' with:what.
+aStream := mgr sourceStreamFor:currentClass revision:rev.
+revString := rev
+].
+self busyLabel:'loading %1' with:what .
+[
+Class withoutUpdatingChangesDo:[
+"/ rename the current class - for backup
+Smalltalk renameClass:currentClass to:currentClass name , '_saved'.
+aStream fileIn.
+].
+] valueNowOrOnUnwindDo:[
+aStream close.
+self normalLabel.
+].
+]
+]
+"Created: 14.11.1995 / 16:43:15 / cg"
+"Modified: 7.12.1995 / 13:19:06 / cg"
+!
+classRevisionInfo
+"show current classes revision info in codeView"
+self doClassMenu:[:currentClass |
+|aStream info info2 s rv mgr|
+aStream := WriteStream on:(String new:200).
+currentClass notNil ifTrue:[
+self busyLabel:'extracting revision info' with:nil.
+info := currentClass revisionInfo.
+rv := currentClass binaryRevision.
+rv notNil ifTrue:[
+aStream nextPutAll:'**** Loaded classes binary information ****'; cr; cr.
+aStream nextPutAll:'  Binary based upon : ' , rv; cr.
+aStream cr.
+].
+info notNil ifTrue:[
+aStream nextPutAll:'**** Classes source information ****'; cr; cr.
+s := info at:#repositoryPath ifAbsent:nil.
+s notNil ifTrue:[
+aStream nextPut:'  Source repository : ' , s; cr
+].
+aStream nextPutAll:'  Filename ........ : ' , (info at:#fileName ifAbsent:'?'); cr.
+aStream nextPutAll:'  Revision ........ : ' , (info at:#revision ifAbsent:'?'); cr.
+aStream nextPutAll:'  Checkin date .... : ' , (info at:#date ifAbsent:'?') , ' ' , (info at:#time ifAbsent:'?'); cr.
+aStream nextPutAll:'  Checkin user .... : ' , (info at:#user ifAbsent:'?'); cr.
+(info2 := currentClass packageSourceCodeInfo) notNil ifTrue:[
+aStream nextPutAll:'  Repository: ..... : ' , (info2 at:#module ifAbsent:'?'); cr.
+aStream nextPutAll:'  Directory: ...... : ' , (info2 at:#directory ifAbsent:'?'); cr.
+].
+aStream nextPutAll:'  Container ....... : ' , (info at:#repositoryPathName ifAbsent:'?'); cr.
+aStream cr.
+(mgr := currentClass sourceCodeManager) notNil ifTrue:[
+aStream nextPutAll:'**** Repository information ****'; cr; cr.
+mgr writeRevisionLogOf:currentClass to:aStream.
+]
+] ifFalse:[
+aStream nextPutAll:'No revision info found'
+]
+].
+codeView contents:(aStream contents).
+codeView modified:false.
+codeView acceptAction:nil.
+codeView explainAction:nil.
+methodListView notNil ifTrue:[
+methodListView deselect
+].
+aspect := #revisionInfo.
+self normalLabel
+]
+"Created: 14.11.1995 / 16:43:15 / cg"
+"Modified: 7.12.1995 / 13:20:42 / cg"
+! !
+!BrowserView methodsFor:'class stuff'!
+checkClassSelected
+"warn and return false, if no class is selected"
+currentClass isNil ifTrue:[
+	self warn:'select a class first'.
+	^ false
+].
+^ true
+!
+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 compile:false).
+	    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
+!
+classListUpdate
+RememberAspect ifTrue:[
+	aspect == #hierarchy ifTrue:[
+	    ^ self classHierarchy
+	].
+	aspect == #classInstVars ifTrue:[
+	    ^ self classClassInstVars
+	].
+	aspect == #comment ifTrue:[
+	    ^ self classComment
+	].
+	aspect == #primitiveDefinitions ifTrue:[
+	    ^ self classPrimitiveDefinitions
+	].
+	aspect == #primitiveFunctions ifTrue:[
+	    ^ self classPrimitiveFunctions
+	].
+	aspect == #primitiveVariables ifTrue:[
+	    ^ self classPrimitiveVariables
+	].
+	aspect == #revisionInfo ifTrue:[
+	    ^ self classRevisionInfo
+	].
+].
+self classDefinition
+"Created: 23.11.1995 / 11:28:58 / cg"
+"Modified: 23.11.1995 / 11:36:08 / cg"
+!
+classSelection:lineNr
+"user clicked on a class line - show method categories"
+|cls oldSelector|
+(currentClassHierarchy notNil
+and:[fullProtocol]) ifTrue:[
+	oldSelector := currentSelector.
+	self updateMethodCategoryListWithScroll:false.
+	self updateMethodListWithScroll:false.
+	self updateVariableList.
+	^ self
+].
+cls := Smalltalk classNamed:classListView selectionValue withoutSpaces.
+cls notNil ifTrue:[
+	self switchToClass:cls.
+	self classSelectionChanged
+]
+!
+classSelectionChanged
+|oldMethodCategory oldMethod oldSelector|
+self withWaitCursorDo:[
+	oldMethodCategory := currentMethodCategory.
+	oldMethod := currentMethod.
+	oldSelector := currentSelector.
+	showInstance ifTrue:[
+	    actualClass := acceptClass := currentClass
+	] ifFalse:[
+	    actualClass := acceptClass := currentClass class
+	].
+	currentMethodCategory := nil.
+	currentMethod := nil.
+	currentSelector := nil.
+	self updateVariableList.
+	self updateMethodCategoryList.
+	oldMethodCategory notNil ifTrue:[
+	    methodCategoryListView selectElement:oldMethodCategory.
+	    methodCategoryListView hasSelection 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.
+	    ].
+	] ifFalse:[
+"/            self classDefinition.
+self classListUpdate.
+	    codeView acceptAction:[:theCode |
+		codeView cursor:Cursor execute.
+		Object abortSignal catch:[
+		    (Compiler evaluate:theCode asString notifying:codeView compile:false)
+		    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
+	    ]
+	].
+	self setDoitActionForClass
+]
+"Created: 23.11.1995 / 11:32:03 / cg"
+!
+doClassMenu:aBlock
+"a helper - check if class is selected and evaluate aBlock
+while showing waitCursor"
+self checkClassSelected ifTrue:[
+	self withWaitCursorDo:[aBlock value:currentClass]
+]
+!
+listOfAllClassesInCategory:aCategory
+"return a list of all classes in a given category"
+|newList classes searchCategory nm|
+(aCategory = '* hierarchy *') ifTrue:[
+	newList := OrderedCollection new.
+	classes := Set new.
+	self classHierarchyDo:[:aClass :lvl|
+	    nm := aClass name.
+	    (classes includes:nm) ifFalse:[
+		classes add:nm.
+		newList add:(String new:lvl) , nm
+	    ]
+	].
+	^ newList
+].
+newList := Set new.
+(aCategory = '* all *') ifTrue:[
+	Smalltalk allBehaviorsDo:[:aClass |
+	    newList add:aClass name
+	]
+] ifFalse:[
+	(aCategory = '* no category *') ifTrue:[
+	    searchCategory := nil
+	] ifFalse:[
+	    searchCategory := aCategory
+	].
+	Smalltalk allBehaviorsDo:[:aClass |
+	    |thisCategory|
+	    aClass isMeta ifFalse:[
+		thisCategory := aClass category.
+		((thisCategory = searchCategory)
+		or:[thisCategory = aCategory]) ifTrue:[
+		    newList add:aClass name
+		]
+	    ]
+	]
+].
+(newList size == 0) ifTrue:[^ nil].
+^ newList asOrderedCollection sort
+!
+listOfClassHierarchyOf:aClass
+"return a hierarchy class-list"
+|startClass classes thisOne|
+showInstance ifTrue:[
+	startClass := aClass
+] ifFalse:[
+	startClass := aClass class.
+].
+classes := startClass allSuperclasses.
+thisOne := Array with:startClass.
+classes notNil ifTrue:[
+	classes := classes reverse , thisOne.
+] ifFalse:[
+	classes := thisOne
+].
+fullProtocol ifFalse:[
+	classes := classes , startClass allSubclassesInOrder
+].
+^ classes collect:[:c | c name]
+!
+renameCurrentClassTo:aString
+"helper - do the rename"
+self doClassMenu:[:currentClass |
+	|oldName oldSym newSym cls|
+	(cls := Smalltalk classNamed:aString) notNil ifTrue:[
+	    (self confirm:(resources string:'WARN_RENAME' with:aString with:cls category))
+		ifFalse:[^ self]
+	].
+	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.
+	    SystemBrowser browseReferendsOf:oldSym warnIfNone:false
+	]
+]
+"Created: 25.11.1995 / 13:02:53 / cg"
+!
+switchToClass:newClass
+"switch to some other class;
+keep instance protocol as it was ..."
+|cls meta|
+fullProtocol ifTrue:[^ self].
+cls := newClass.
+(meta := cls isMeta) ifTrue:[
+	cls := cls soleInstance
+].
+currentClass notNil ifTrue:[
+	currentClass removeDependent:self
+].
+currentClass := cls.
+showInstance ifTrue:[
+actualClass := acceptClass := cls.
+] ifFalse:[
+actualClass := acceptClass := cls class.
+].
+currentClass notNil ifTrue:[
+	currentClass addDependent:self.
+].
+self normalLabel.
+"Modified: 1.9.1995 / 01:04:05 / claus"
+!
+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
+!
+switchToClassNamed:aString
+|meta str classSymbol theClass newCat element|
+meta := false.
+str := aString.
+classSymbol := aString asSymbolIfInterned.
+classSymbol isNil ifTrue:[
+	(aString endsWith:'class') ifTrue:[
+	    str := aString copyWithoutLast:5.
+	    classSymbol := str asSymbolIfInterned.
+	    classSymbol isNil ifTrue:[
+		^ self
+	    ].
+	    meta := true
+	].
+].
+theClass := Smalltalk at:classSymbol.
+(theClass isNil and:[str endsWith:'class']) ifTrue:[
+	str := str copyWithoutLast:5.
+	classSymbol := str asSymbolIfInterned.
+	classSymbol isNil ifTrue:[
+	    ^ self
+	].
+	meta := true.
+	theClass := Smalltalk at:classSymbol.
+].
+theClass == currentClass ifTrue:[^ self].
+theClass isBehavior ifTrue:[
+	classCategoryListView notNil ifTrue:[
+	    currentClassHierarchy isNil ifTrue:[
+		((newCat := theClass category) ~= currentClassCategory) ifTrue:[
+		    currentClassCategory := newCat.
+		    newCat isNil ifTrue:[
+			element := '* no category *'
+		    ] ifFalse:[
+			element := newCat.
+		    ].
+		    classCategoryListView selectElement:element.
+		    "/ classCategoryListView makeSelectionVisible.
+		]
+	    ]
+	].
+	self updateClassList.
+	self switchToClass:theClass.
+	classListView selectElement:str.
+	self instanceProtocol:meta not.
+	self classSelectionChanged
+]
+"Modified: 1.9.1995 / 01:41:35 / claus"
+!
+templateFor:className in:cat
+"return a class definition template - be smart in what is offered initially"
+|aString name i|
+name := 'NewClass'.
+i := 1.
+[name knownAsSymbol and:[Smalltalk includesKey:name asSymbol]] whileTrue:[
+	i := i + 1.
+	name := 'NewClass' , i printString
+].
+aString := className , ' subclass:#' , name , '
+	instanceVariableNames: ''''
+	classVariableNames: ''''
+	poolDictionaries: ''''
+	category: '''.
+cat notNil ifTrue:[
+	aString := aString , cat
+].
+aString := aString , '''
+"
+Replace ''' , className , ''', ''', name , ''' and
+the empty string arguments by true values.
+Install (or change) the class by ''accepting'',
+either via the menu or the keyboard (usually CMD-A).
+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.
+"
+'.
+^ aString
+!
+updateClassList
+self updateClassListWithScroll:true
+!
+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:[
+	    currentClassHierarchy notNil ifTrue:[
+		classes := self listOfClassHierarchyOf:currentClassHierarchy
+	    ]
+	].
+	classListView list = classes ifFalse:[
+	    scroll ifTrue:[
+		classListView contents:classes
+	    ] ifFalse:[
+		classListView setContents:classes
+	    ].
+	    oldClassName notNil ifTrue:[
+		classListView setContents:classes.
+		classListView selectElement:oldClassName
+	    ] ifFalse:[
+		variableListView notNil ifTrue:[variableListView contents:nil]
+	    ]
+	].
+	scroll ifTrue:[
+	    fullProtocol ifTrue:[
+		classListView scrollToBottom
+	    ]
+	]
+]
+! !
+!BrowserView methodsFor:'class-method list menu'!
+classMethodFileOutAll
+"fileout all methods into one source file"
+|list classString selectorString cls mth outStream fileName append
+fileBox|
+append := false.
+fileBox := FileSaveBox
+			title:(resources string:'save methodss in:')
+			okText:(resources string:'save')
+			abortText:(resources string:'cancel')
+			action:[:fName | fileName := fName].
+fileBox appendAction:[:fName | fileName := fName. append := true].
+fileBox initialText:'some_methods.st'.
+Project notNil ifTrue:[
+	fileBox directory:Project currentProjectDirectory
+].
+fileBox showAtPointer.
+fileName notNil ifTrue:[
+	"
+	 if file exists, save original in a .sav file
+	"
+	fileName asFilename exists ifTrue:[
+	    fileName asFilename copyTo:(fileName , '.sav')
+	].
+	append ifTrue:[
+	    outStream := FileStream appendingOldFileNamed:fileName
+	] ifFalse:[
+	    outStream := FileStream newFileNamed:fileName.
+	].
+	outStream isNil ifTrue:[
+	    ^ self warn:'cannot create: %1' with:fileName
+	].
+	self withWaitCursorDo:[
+	    list := classMethodListView list.
+	    list do:[:line |
+		self busyLabel:'writing: ' with:line.
+		classString := self classFromClassMethodString:line.
+		selectorString := self selectorFromClassMethodString:line.
+		((classString ~= 'Metaclass') and:[classString endsWith:'class']) ifTrue:[
+		    classString := classString copyWithoutLast:5 "copyTo:(classString size - 5)".
+		    cls := (Smalltalk at:classString asSymbol).
+		    cls := cls class
+		] ifFalse:[
+		    cls := (Smalltalk at:classString asSymbol).
+		].
+		cls isNil ifTrue:[
+		    self warn:'oops class %1 is gone' with:classString
+		] ifFalse:[
+		    mth := cls compiledMethodAt:(selectorString asSymbol).
+		    Class fileOutErrorSignal handle:[:ex |
+			|box|
+			box := YesNoBox
+				    title:('fileOut error: '
+					   , ex errorString
+					   , '\\continue anyway ?') withCRs
+				    yesText:'continue'
+				    noText:'abort'.
+			box confirm ifTrue:[
+			    ex proceed
+			].
+			self normalLabel.
+			^ self
+		    ] do:[
+			cls fileOutMethod:mth on:outStream.
+		    ]
+		]
+	    ].
+	    outStream close.
+	    self normalLabel.
+	]
+]
+!
+classMethodMenu
+|labels selectors|
+labels := #(
+				'fileOut'
+				'fileOut all'
+				'printOut'
+				'-'
+				'spawn'
+				'spawn class'
+				'spawn full protocol'
+				'spawn hierarchy'
+				'-'
+				'senders ...'
+				'implementors ...'
+				'globals ...'
+"/                              '-'
+"/                              'breakpoint'
+"/                              'trace'
+"/                              'trace sender'
+				'-'
+				'remove'
+	       ).
+selectors := #(
+				methodFileOut
+				classMethodFileOutAll
+				methodPrintOut
+				nil
+				methodSpawn
+				classSpawn
+				classSpawnFullProtocol
+				classSpawnHierarchy
+				nil
+				methodSenders
+				methodImplementors
+				methodGlobalReferends
+"/                              nil
+"/                              methodBreakPoint
+"/                              methodTrace
+"/                              methodTraceSender
+				nil
+				methodRemove
+		  ).
+^ PopUpMenu labels:(resources array:labels)
+		selectors:selectors
+! !
+!BrowserView methodsFor:'class-method stuff'!
+classFromClassMethodString:aString
+"helper for classMethod-list - extract class name from the string"
+"/    |pos|
+"/
+"/    pos := aString indexOf:(Character space).
+"/    ^ aString copyTo:(pos - 1)
+^ aString upTo:Character space
+!
+classMethodSelection:lineNr
+"user clicked on a class/method line - show code"
+|cls string classString selectorString meta|
+string := classMethodListView selectionValue.
+classString := self classFromClassMethodString:string.
+selectorString := self selectorFromClassMethodString:string.
+((classString ~= 'Metaclass') and:[classString endsWith:'class']) ifTrue:[
+	classString := classString copyWithoutLast:5 "copyTo:(classString size - 5)".
+	meta := true.
+] ifFalse:[
+	meta := false.
+].
+self switchToClass:(Smalltalk at:classString asSymbol).
+meta ifTrue:[cls := currentClass class] ifFalse:[cls := currentClass].
+actualClass := acceptClass := cls.
+currentClass isNil ifTrue:[
+	self warn:'oops class is gone'
+] ifFalse:[
+	currentClassCategory := currentClass category.
+	currentSelector := selectorString asSymbol.
+	currentMethod := actualClass compiledMethodAt:currentSelector.
+	currentMethod isNil ifTrue:[
+	    self warn:'oops method is gone'
+	] ifFalse:[
+	    currentMethodCategory := currentMethod category.
+	].
+	self methodSelectionChanged
+].
+self setDoitActionForClass
+"Modified: 31.8.1995 / 11:56:02 / claus"
+!
+selectorFromClassMethodString:aString
+"helper for classMethod-list - extract selector from the string"
+|pos|
+pos := aString indexOf:(Character space).
+^ aString copyFrom:(pos + 1)
+! !
+!BrowserView methodsFor:'help'!
+helpTextFor:aComponent
+|s|
+aComponent == classCategoryListView ifTrue:[
+	s := 'HELP_CCAT_LIST'
+].
+aComponent == classListView ifTrue:[
+	fullProtocol ifTrue:[
+	    s := 'HELP_PCLASS_LIST'
+	] ifFalse:[
+	    currentClassHierarchy notNil ifTrue:[
+		s := 'HELP_HCLASS_LIST'
+	    ] ifFalse:[
+		s := 'HELP_CLASS_LIST'
+	    ]
+	]
+].
+aComponent == methodCategoryListView ifTrue:[
+	s := 'HELP_MCAT_LIST'
+].
+aComponent == methodListView ifTrue:[
+	s := 'HELP_METHOD_LIST'
+].
+aComponent == variableListView ifTrue:[
+	s := 'HELP_VAR_LIST'
+].
+aComponent == codeView ifTrue:[
+	fullClass ifTrue:[
+	    s := 'HELP_FULLCODE_VIEW'
+	] ifFalse:[
+	    s := 'HELP_CODE_VIEW'
+	]
+].
+(aComponent == instanceToggle
+or:[aComponent == classToggle]) ifTrue:[
+	s := 'HELP_INST_CLASS_TOGGLE'
+].
+aComponent == classMethodListView ifTrue:[
+	s := 'HELP_CLSMTHOD_LIST'
+].
+s notNil ifTrue:[
+	^ resources string:s
+].
+^ nil
+"Modified: 31.8.1995 / 19:11:39 / claus"
+! !
+!BrowserView methodsFor:'initialize / release'!
+autoSearch:aString
+"used with class-method list browsing. If true,
+selecting an entry from the list will automatically
+search for the searchstring in the codeView"
+self setSearchPattern:aString.
+autoSearch := aString
+!
+destroy
+"relese dependant - destroy popups"
+Smalltalk removeDependent:self.
+currentClass notNil ifTrue:[
+	currentClass removeDependent:self.
+	currentClass := nil
+].
+super destroy
+!
+initialize
+super initialize.
+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).
+	"
+	 tell classCategoryListView to ask for the menu
+	"
+	v menuHolder:self; menuPerformer:self; menuMessage:#classCategoryMenu.
+].
+v := classListView.
+v notNil ifTrue:[
+	v action:[:lineNr | self classSelection:lineNr].
+	v selectConditionBlock:checkBlock.
+	v ignoreReselect:false.
+	"
+	 tell classListView to ask for the menu
+	"
+	v menuHolder:self; menuPerformer:self; menuMessage:#classMenu.
+].
+v := methodCategoryListView.
+v notNil ifTrue:[
+	v action:[:lineNr | self methodCategorySelection:lineNr].
+	v selectConditionBlock:checkBlock.
+	v ignoreReselect:false.
+	"
+	 tell methodCategoryListView to ask for the menu
+	"
+	v menuHolder:self; menuPerformer:self; menuMessage:#methodCategoryMenu.
+].
+v := methodListView.
+v notNil ifTrue:[
+	v action:[:lineNr | self methodSelection:lineNr].
+	v selectConditionBlock:checkBlock.
+	v ignoreReselect:false.
+	"
+	 tell methodListView to ask for the menu
+	"
+	v menuHolder:self; menuPerformer:self; menuMessage:#methodMenu.
+].
+v := classMethodListView.
+v notNil ifTrue:[
+	v action:[:lineNr | self classMethodSelection:lineNr].
+	v selectConditionBlock:checkBlock.
+	v ignoreReselect:false.
+	"
+	 tell classMethodListView to ask for the menu
+	"
+	v menuHolder:self; menuPerformer:self; menuMessage:#classMethodMenu.
+].
+v := variableListView.
+v notNil ifTrue:[
+	v action:[:lineNr | self variableSelection:lineNr].
+	v ignoreReselect:false.
+	v toggleSelect:true.
+	v menuHolder:self; menuPerformer:self; menuMessage:#variableListMenu.
+].
+"
+normal browsers show the top at first;
+hierarchy and fullProtocol browsers better show the end
+initially
+"
+currentClassHierarchy notNil ifTrue:[
+	classListView scrollToBottom.
+]
+!
+terminate
+(self checkSelectionChangeAllowed) ifTrue:[
+	super terminate
+]
+!
+title:someString
+myLabel := someString.
+self label:someString.
+! !
+!BrowserView methodsFor:'initialize subviews'!
+createClassListViewIn:frame
+"setup the classlist subview, with its toggles"
+|v panel|
+self createTogglesIn:frame.
+"
+oldstyle had no variableList ...
+"
+"/    v := ScrollableView for:SelectionInListView in:frame.
+"/    v origin:(0.0 @ 0.0)
+"/      extent:[frame width
+"/            @
+"/           (frame height
+"/            - ViewSpacing
+"/            - instanceToggle height
+"/            - instanceToggle borderWidth
+"/            + v borderWidth)].
+"/
+"/    classListView := v scrolledView
+panel := VariableVerticalPanel
+		    origin:(0.0 @ 0.0)
+		    corner:[frame width
+			    @
+			    (frame height
+			      - ViewSpacing
+			      - instanceToggle height
+			      "-" "+ instanceToggle borderWidth "
+			      + v borderWidth)]
+			in:frame.
+v := ScrollableView for:SelectionInListView in:panel.
+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.7) corner:(1.0 @ 1.0).
+variableListView := v scrolledView.
+!
+createCodeViewIn:aView
+"setup the code view"
+^ self createCodeViewIn:aView at:0.25
+!
+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"
+|h halfSpace classAction instanceAction|
+classAction := [self instanceProtocol:false].
+instanceAction := [self instanceProtocol:true].
+halfSpace := ViewSpacing // 2.
+instanceToggle := Toggle label:(resources at:'instance') in:aFrame.
+h := instanceToggle heightIncludingBorder.
+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 heightIncludingBorder.
+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 bottomInset:halfSpace.
+	classToggle bottomInset:halfSpace.
+	instanceToggle leftInset:halfSpace.
+	classToggle leftInset:halfSpace.
+	instanceToggle rightInset:ViewSpacing - halfSpace.
+	classToggle rightInset:ViewSpacing - halfSpace.
+].
+!
+focusSequence
+|s|
+s := OrderedCollection new.
+classCategoryListView notNil ifTrue:[
+	s add:classCategoryListView
+].
+classListView notNil ifTrue:[
+	s add:classListView
+].
+"/    variableListView notNil ifTrue:[
+"/        s add:variableListView
+"/    ].
+instanceToggle notNil ifTrue:[
+	s add:instanceToggle.
+].
+methodCategoryListView notNil ifTrue:[
+	s add:methodCategoryListView
+].
+methodListView notNil ifTrue:[
+	s add:methodListView
+].
+classMethodListView notNil ifTrue:[
+	s add:classMethodListView
+].
+s add:codeView.
+^ s
+!
+setupForAll
+"create subviews for a full browser"
+|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.
+v := HVScrollableView for:SelectionInListView
+			  miniScrollerH:true miniScrollerV:false
+			  in:hpanel.
+v origin:(0.0 @ 0.0) corner:(0.25 @ 1.0).
+classCategoryListView := v scrolledView.
+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 origin:(0.5 @ 0.0) corner:(0.75 @ 1.0).
+methodCategoryListView := v scrolledView.
+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 createCodeViewIn:vpanel
+!
+setupForClass:aClass
+"create subviews for browsing a single class"
+|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.5 @ 1.0)in:hpanel.
+self createTogglesIn:frame.
+v := ScrollableView for:SelectionInListView in:frame.
+v origin:(0.0 @ 0.0)
+extent:[frame width
+	      @
+	      (frame height
+	       - ViewSpacing
+	       - instanceToggle height
+	       - instanceToggle borderWidth
+	       + v borderWidth)].
+methodCategoryListView := v scrolledView.
+v := ScrollableView for:SelectionInListView in:hpanel.
+v origin:(0.5 @ 0.0) corner:(1.0 @ 1.0).
+methodListView := v scrolledView.
+self createCodeViewIn:vpanel.
+self switchToClass:aClass.
+actualClass := acceptClass := aClass.
+self updateMethodCategoryList.
+self updateMethodList.
+self updateCodeView.
+self classDefinition.
+!
+setupForClass:aClass methodCategory:aMethodCategory
+"setup subviews to browse a method category"
+|vpanel v|
+vpanel := VariableVerticalPanel
+			origin:(0.0 @ 0.0) corner:(1.0 @ 1.0)
+			    in:self.
+v := ScrollableView for:SelectionInListView in:vpanel.
+v origin:(0.0 @ 0.0) corner:(1.0 @ 0.25).
+methodListView := v scrolledView.
+self createCodeViewIn:vpanel.
+currentClassCategory := aClass category.
+self switchToClass:aClass.
+actualClass := acceptClass := aClass.
+currentMethodCategory := aMethodCategory.
+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 := acceptClass := aClass.
+currentSelector := selector.
+currentMethod := currentClass compiledMethodAt:selector.
+currentMethodCategory := currentMethod category.
+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
+!
+setupForClassHierarchy:aClass
+"setup subviews to browse a class hierarchy"
+|vpanel hpanel frame v cls|
+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.
+cls := aClass.
+cls isMeta ifTrue:[
+	cls := cls soleInstance
+].
+currentClassHierarchy := currentClass := actualClass := cls.
+self updateClassList.
+classListView selectElement:aClass name; makeSelectionVisible.
+self updateMethodCategoryList.
+self updateMethodList.
+self updateCodeView.
+aClass isMeta ifTrue:[
+	self instanceProtocol:false
+].
+!
+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]) asOrderedCollection.
+classListView list:(l sort).
+self updateMethodCategoryList.
+self updateMethodList.
+self updateCodeView
+!
+setupForFullClass
+"setup subviews to browse a class as full text"
+|vpanel hpanel 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.
+v := ScrollableView for:SelectionInListView in:hpanel.
+v origin:(0.0 @ 0.0) corner:(0.5 @ 1.0).
+classCategoryListView := v scrolledView.
+classCategoryListView contents:(self listOfAllClassCategories).
+v := ScrollableView for:SelectionInListView in:hpanel.
+v origin:(0.5 @ 0.0) corner:(1.0 @ 1.0).
+classListView := v scrolledView.
+self createCodeViewIn:vpanel.
+fullClass := true.
+self updateCodeView
+!
+setupForFullClassProtocol:aClass
+"setup subviews to browse a classes full protocol"
+|vpanel hpanel frame v cls|
+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.
+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 createCodeViewIn:vpanel at:0.4.
+cls := aClass.
+cls isMeta ifTrue:[
+	cls := cls soleInstance
+].
+currentClassHierarchy := actualClass := acceptClass := currentClass := cls.
+fullProtocol := true.
+self updateClassList.
+self updateMethodCategoryList.
+self updateMethodList.
+self updateCodeView.
+self updateVariableList.
+aClass isMeta ifTrue:[
+	self instanceProtocol:false
+].
+!
+setupForList:aList
+"setup subviews to browse methods from a list"
+|vpanel v|
+vpanel := VariableVerticalPanel
+			origin:(0.0 @ 0.0)
+			corner:(1.0 @ 1.0)
+			    in:self.
+v := ScrollableView for:SelectionInListView in:vpanel.
+v origin:(0.0 @ 0.0) corner:(1.0 @ 0.25).
+classMethodListView := v scrolledView.
+classMethodListView contents:aList.
+self createCodeViewIn:vpanel.
+aList size == 1 ifTrue:[
+	classMethodListView selection:1.
+	self classMethodSelection:1.
+].
+self updateCodeView
+! !
+!BrowserView methodsFor:'method category list menu'!
+methodCategoryCopyCategory
+"show the enter box to copy from an existing method category"
+|title box|
+showInstance ifTrue:[
+	title := 'class to copy instance method category from:'
+] ifFalse:[
+	title := 'class to copy class method category from:'
+].
+box := self listBoxTitle:title
+		      okText:'ok'
+			list:(Smalltalk allClasses collect:[:cls | cls name]) asArray sort.
+box action:[:aString | self copyMethodsFromClass:aString].
+box showAtPointer
+!
+methodCategoryCreateAccessMethods
+"create access methods for all instvars"
+self checkClassSelected ifFalse:[^ self].
+showInstance ifFalse:[
+	self warn:'select instance - and try again'.
+	^ self.
+].
+self withWaitCursorDo:[
+	|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:[
+		Transcript showCr:'method ''', name , ''' already present'
+	    ].
+	    (currentClass implements:((name , ':') asSymbol)) ifFalse:[
+		source := (name , ':something\    "set ' , name , '"\\    ' , name , ' := something.') withCRs.
+		Compiler compile:source forClass:currentClass inCategory:'accessing'.
+	    ] ifTrue:[
+		Transcript showCr:'method ''', name , ':'' already present'
+	    ].
+	].
+	self updateMethodCategoryListWithScroll:false.
+	self updateMethodListWithScroll:false
+]
+!
+methodCategoryCreateDocumentationMethods
+"create empty documentation methods"
+|cls histStream|
+self checkClassSelected ifFalse:[^ self].
+cls := currentClass class.
+self withWaitCursorDo:[
+	|nm names source|
+	"/ add version method containing RCS template
+	"/ but only if not already present.
+	(cls implements:#version) ifFalse:[
+	    Compiler compile:
+'version
+"
+$' , 'Header$
+"
+'                   forClass:cls
+		  inCategory:'documentation'.
+	].
+	"/ add documentation method containing doc template
+	"/ but only if not already present.
+	(cls implements:#documentation) ifFalse:[
+	    Compiler compile:
+'documentation
+"
+documentation to be added.
+"
+'                   forClass:cls
+		  inCategory:'documentation'.
+	].
+	"/ add examples method containing examples template
+	"/ but only if not already present.
+	(cls implements:#examples) ifFalse:[
+	    Compiler compile:
+'examples
+"
+examples to be added.
+"
+'                   forClass:cls
+		  inCategory:'documentation'.
+	].
+	"/ add history method containing created-entry
+	"/ but only if not already present.
+	(cls implements:#history) ifFalse:[
+	    histStream := ReadWriteStream on: String new.
+	    histStream nextPutAll: 'history'; cr.
+	    HistoryLine isBehavior ifTrue:[
+		histStream nextPutAll: (HistoryLine newCreated printString); cr.
+	    ] ifFalse:[
+		histStream cr.
+	    ].
+	    Compiler compile:(histStream contents)
+		    forClass:cls
+		  inCategory:'documentation'.
+	].
+	self instanceProtocol:false.
+	self switchToMethodNamed:#documentation
+"/        self updateMethodCategoryListWithScroll:false.
+"/        self updateMethodListWithScroll:false
+]
+!
+methodCategoryFileOut
+"fileOut all methods in the selected methodcategory of
+the current class"
+self checkClassSelected ifFalse:[^ self].
+self whenMethodCategorySelected:[
+	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.
+]
+!
+methodCategoryFileOutAll
+"fileOut all methods in the selected methodcategory of
+the current class"
+self whenMethodCategorySelected:[
+	|fileName outStream|
+	fileName := currentMethodCategory , '.st'.
+	fileName replaceAll:Character space by:$_.
+	"
+	 this test allows a smalltalk to be built without Projects/ChangeSets
+	"
+	Project notNil ifTrue:[
+	    fileName := Project currentProjectDirectory , fileName.
+	].
+	"
+	 if file exists, save original in a .sav file
+	"
+	fileName asFilename exists ifTrue:[
+	    fileName asFilename copyTo:(fileName , '.sav')
+	].
+	outStream := FileStream newFileNamed:fileName.
+	outStream isNil ifTrue:[
+	    ^ self warn:'cannot create: %1' with:fileName
+	].
+	self busyLabel:'saving: ' with:currentMethodCategory.
+	Class fileOutErrorSignal handle:[:ex |
+	    self warn:'cannot create: %1' with:ex parameter.
+	    ex return
+	] do:[
+	    Smalltalk allBehaviorsDo:[:class |
+		|hasMethodsInThisCategory|
+		hasMethodsInThisCategory := false.
+		class methodArray do:[:method |
+		    method category = currentMethodCategory ifTrue:[
+			hasMethodsInThisCategory := true
+		    ]
+		].
+		hasMethodsInThisCategory ifTrue:[
+		    class fileOutCategory:currentMethodCategory on:outStream.
+		    outStream cr
+		].
+		hasMethodsInThisCategory := false.
+		class class methodArray do:[:method |
+		    method category = currentMethodCategory ifTrue:[
+			hasMethodsInThisCategory := true
+		    ]
+		].
+		hasMethodsInThisCategory ifTrue:[
+		    class class fileOutCategory:currentMethodCategory on:outStream.
+		    outStream cr
+		]
+	    ].
+	].
+	outStream close.
+	self normalLabel.
+].
+!
+methodCategoryFindAnyMethod
+|box|
+box := self enterBoxForSearchSelectorTitle:'method selector to search for:'.
+box action:[:aString | self switchToAnyMethodNamed:aString].
+box showAtPointer
+!
+methodCategoryFindMethod
+|box|
+box := self enterBoxForSearchSelectorTitle:'method selector to search for:'.
+box action:[:aString | self switchToMethodNamed:aString].
+box showAtPointer
+!
+methodCategoryMenu
+|labels selectors i|
+currentClass isNil ifTrue:[
+	methodCategoryListView flash.
+	^ nil
+].
+currentMethodCategory isNil ifTrue:[
+	labels := #(
+		    'find method here ...'
+		    'find method ...'
+		    '-'
+		    'new category ...'
+		    'copy category ...'
+		    'create access methods'
+		   ).
+	selectors := #(
+		    methodCategoryFindMethod
+		    methodCategoryFindAnyMethod
+		    nil
+		    methodCategoryNewCategory
+		    methodCategoryCopyCategory
+		    methodCategoryCreateAccessMethods
+		   ).
+] ifFalse:[
+	labels := #(
+		    'fileOut'
+		    'fileOut all'
+		    'printOut'
+		    '-'
+		    'SPAWN_METHODCATEGORY'
+		    'spawn category'
+		    '-'
+		    'find method here ...'
+		    'find method ...'
+		    '-'
+		    'new category ...'
+		    'copy category ...'
+		    'create access methods'
+		    'rename ...'
+		    'remove'
+		   ).
+	selectors := #(
+		    methodCategoryFileOut
+		    methodCategoryFileOutAll
+		    methodCategoryPrintOut
+		    nil
+		    methodCategorySpawn
+		    methodCategorySpawnCategory
+		    nil
+		    methodCategoryFindMethod
+		    methodCategoryFindAnyMethod
+		    nil
+		    methodCategoryNewCategory
+		    methodCategoryCopyCategory
+		    methodCategoryCreateAccessMethods
+		    methodCategoryRename
+		    methodCategoryRemove
+		   ).
+].
+showInstance ifFalse:[
+	labels := labels copy.
+	selectors := selectors copy.
+	i := labels indexOf:'create access methods'.
+	labels at:i put:'create documentation stubs'.
+	selectors at:i put:#methodCategoryCreateDocumentationMethods
+].
+^ PopUpMenu labels:(resources array:labels)
+		 selectors:selectors
+!
+methodCategoryNewCategory
+"show the enter box to add a new method category.
+Offer existing superclass categories in box to help avoiding
+useless typing."
+|someCategories existingCategories box|
+actualClass notNil ifTrue:[
+	someCategories := actualClass allCategories
+] ifFalse:[
+	"
+	 mhmh - offer some typical categories ...
+	"
+	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
+!
+methodCategoryPrintOut
+|printStream|
+self checkClassSelected ifFalse:[^ self].
+self whenMethodCategorySelected:[
+	printStream := Printer new.
+	actualClass printOutCategory:currentMethodCategory on:printStream.
+	printStream close
+]
+!
+methodCategoryRemove
+"show number of methods to remove and query user"
+|count t box|
+currentMethodCategory notNil ifTrue:[
+	count := 0.
+	actualClass methodArray do:[:aMethod |
+	    (aMethod category = currentMethodCategory) ifTrue:[
+		count := count + 1
+	    ]
+	].
+	(count == 0) ifTrue:[
+	    currentMethodCategory := nil.
+	    currentMethod := currentSelector := nil.
+	    self updateMethodCategoryListWithScroll:false.
+	    self updateMethodList
+	] ifFalse:[
+	    (count == 1) ifTrue:[
+		t := 'remove %1\(with 1 method) ?'
+	    ] ifFalse:[
+		t := 'remove %1\(with %2 methods) ?'
+	    ].
+	    t := resources string:t with:currentMethodCategory with:count printString.
+	    t := t withCRs.
+	    box := YesNoBox
+		       title:t
+		       yesText:(resources at:'remove')
+		       noText:(resources at:'abort').
+	    box confirm ifTrue:[
+		actualClass methodArray do:[:aMethod |
+		    (aMethod category = currentMethodCategory) ifTrue:[
+			actualClass
+			    removeSelector:(actualClass selectorAtMethod:aMethod)
+		    ]
+		].
+		currentMethodCategory := nil.
+		currentMethod := currentSelector := nil.
+		self updateMethodCategoryList.
+		self updateMethodList
+	    ]
+	]
+]
+!
+methodCategoryRename
+"launch an enterBox to rename current method category"
+|box|
+self checkMethodCategorySelected ifFalse:[^ self].
+box := self enterBoxTitle:(resources string:'rename method category %1 to:' with:currentMethodCategory)
+		okText:(resources at:'rename').
+box initialText:currentMethodCategory.
+box action:[:aString |
+	actualClass renameCategory:currentMethodCategory to:aString.
+	currentMethodCategory := aString.
+	currentMethod := currentSelector := nil.
+	self updateMethodCategoryList.
+	self updateMethodListWithScroll:false
+].
+box showAtPointer
+!
+methodCategorySpawn
+"create a new SystemBrowser browsing current method category"
+currentMethodCategory notNil ifTrue:[
+	self withWaitCursorDo:[
+	    SystemBrowser 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 |
+					SystemBrowser browseMethodCategory:aString
+				    ]
+! !
+!BrowserView methodsFor:'method category stuff'!
+checkMethodCategorySelected
+currentMethodCategory isNil ifTrue:[
+	self warn:'select a method category first'.
+	^ false
+].
+^ true
+!
+copyMethodsFromClass:aClassName
+|class box|
+currentClass notNil ifTrue:[
+	class := Smalltalk classNamed:aClassName.
+	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
+currentClass notNil ifTrue:[
+	Object abortSignal catch:[
+	    class methodArray do:[:aMethod |
+		|source|
+		(category match:aMethod category) ifTrue:[
+		    source := aMethod source.
+		    codeView contents:source.
+		    codeView modified:false.
+		    actualClass compilerClass
+			 compile:source
+			 forClass:actualClass
+			 inCategory:aMethod category
+			 notifying:codeView.
+		    self updateMethodCategoryListWithScroll:false.
+		    self updateMethodListWithScroll:false.
+		]
+	    ]
+	]
+]
+!
+listOfAllMethodCategoriesInClass:aClass
+"answer a list of all method categories of the argument, aClass"
+|newList|
+newList := Set new.
+aClass methodArray do:[:aMethod |
+	|cat|
+	cat := aMethod category.
+	cat isNil ifTrue:[
+	    cat := '* no category *'
+	].
+	newList add:cat
+].
+(newList size == 0) ifTrue:[^ nil].
+newList add:'* all *'.
+^ newList asOrderedCollection sort
+!
+listOfAllMethodCategoriesInFullProtocolHierarchy:aClass
+"answer a list of all method categories of the argument, aClass,
+and all of its superclasses.
+Used with fullProtocol browsing."
+|newList|
+newList := Set new.
+self classesInFullProtocolHierarchy:aClass do:[:c |
+	|cat|
+	c methodArray do:[:aMethod |
+	    cat := aMethod category.
+	    cat isNil ifTrue:[
+		cat := '* no category *'
+	    ].
+	    newList add:cat
+	]
+].
+(newList size == 0) ifTrue:[^ nil].
+newList add:'* all *'.
+^ newList asOrderedCollection 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.
+aspect := nil.
+"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 hasSelection ifTrue:[
+"/              self methodSelection:methodListView selection.
+"/          ]
+"/      ]
+]
+"Created: 23.11.1995 / 14:19:56 / cg"
+!
+methodCategorySelectionChanged
+"method category selection has changed - update dependent views"
+self withWaitCursorDo:[
+	currentMethod := currentSelector := nil.
+	self updateMethodList.
+	self updateCodeView.
+	currentMethodCategory notNil ifTrue:[
+	    methodCategoryListView selectElement:currentMethodCategory
+	].
+	self setAcceptAndExplainActionsForMethod.
+	self hilightMethodsInMethodCategoryList:false inMethodList:true.
+]
+"Created: 23.11.1995 / 14:17:38 / cg"
+"Modified: 23.11.1995 / 14:19:49 / cg"
+!
+newMethodCategory:aString
+|categories|
+currentClass isNil ifTrue:[
+	^ self warn:'select/create a class first'.
+].
+categories := methodCategoryListView list.
+categories isNil ifTrue:[categories := OrderedCollection new].
+(categories includes:aString) ifFalse:[
+	categories add:aString.
+	categories sort.
+	methodCategoryListView contents:categories
+].
+currentMethodCategory := aString.
+self methodCategorySelectionChanged
+!
+updateMethodCategoryList
+self updateMethodCategoryListWithScroll:true
+!
+updateMethodCategoryListWithScroll:scroll
+|categories|
+methodCategoryListView notNil ifTrue:[
+	fullProtocol ifTrue:[
+	    currentClassHierarchy notNil ifTrue:[
+		categories := self listOfAllMethodCategoriesInFullProtocolHierarchy:actualClass
+	    ]
+	] 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
+	    ]
+	]
+]
+!
+whenMethodCategorySelected:aBlock
+self checkMethodCategorySelected ifTrue:[
+	self withWaitCursorDo:aBlock
+]
+! !
+!BrowserView methodsFor:'method list menu'!
+commonTraceHelperWith:aSelector
+currentMethod := MessageTracer perform:aSelector with:currentMethod.
+self updateMethodListWithScroll:false keepSelection:true.
+currentClass changed:#methodDictionary with:currentSelector.
+!
+methodAproposSearch
+"launch an enterBox for a keyword search"
+self askForSelectorTitle:'keyword to search for:'
+		    openWith:#aproposSearch:
+!
+methodBreakPoint
+"set a breakpoint on the current method"
+currentSelector notNil ifTrue:[
+	currentMethod := actualClass compiledMethodAt:currentSelector.
+	currentMethod isWrapped ifFalse:[
+	    (currentMethod notNil and:[currentMethod isWrapped not]) ifTrue:[
+		self commonTraceHelperWith:#trapMethod:
+	    ]
+	].
+]
+!
+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].
+actualClass isNil ifTrue:[
+	box := self enterBoxTitle:'' okText:'change'.
+] ifFalse:[
+	|someCategories|
+	someCategories := actualClass categories sort.
+	box := self listBoxTitle:'' okText:'change' list:someCategories.
+].
+box title:('change category from ''' , currentMethod category , ''' to:').
+lastMethodCategory isNil ifTrue:[
+	txt := currentMethod category.
+] ifFalse:[
+	txt := lastMethodCategory
+].
+box initialText:txt.
+box action:[:aString |
+		    lastMethodCategory := aString.
+		    currentMethod category:aString asSymbol.
+		    actualClass changed.
+		    currentMethod changed:#category.
+		    actualClass updateRevisionString.
+		    actualClass addChangeRecordForMethodCategory:currentMethod category:aString.
+		    self updateMethodCategoryListWithScroll:false.
+		    self updateMethodListWithScroll:false
+	       ].
+box showAtPointer
+"Created: 29.10.1995 / 19:59:22 / cg"
+!
+methodDecompile
+"decompile the current methods bytecodes.
+The Decompiler is delivered as an extra, and not normally
+avaliable with the system."
+self checkMethodSelected ifFalse:[^ self].
+Decompiler notNil ifTrue:[
+	Autoload autoloadFailedSignal handle:[:ex |
+	    ex return
+	] do:[
+	    Decompiler autoload.
+	].
+].
+Decompiler isLoaded ifFalse:[
+	Smalltalk
+	    fileIn:'/phys/clam/claus/work/libcomp/not_delivered/Decomp.st'
+	    logged:false.
+].
+Decompiler isLoaded ifFalse:[
+	^ self warn:'No decompiler available'.
+].
+Decompiler decompile:currentMethod.
+!
+methodFileOut
+"file out the current method"
+self checkMethodSelected ifFalse:[^ self].
+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.
+!
+methodGlobalReferends
+"launch an enterBox for global symbol to search for"
+self enterBoxForBrowseTitle:'global variable to browse users of:'
+			 action:[:aString |
+				    SystemBrowser browseReferendsOf:aString asSymbol
+				]
+!
+methodImplementors
+"launch an enterBox for selector to search for"
+self askForSelectorTitle:'selector to browse implementors of:'
+		    openWith:#browseImplementorsOf:
+!
+methodInspect
+"inspect  the current method"
+self checkMethodSelected ifFalse:[^ self].
+(actualClass compiledMethodAt:currentSelector) inspect.
+!
+methodLocalAproposSearch
+"launch an enterBox for a local keyword search"
+self askForSelectorTitle:'keyword to search for:'
+		    openWith:#aproposSearch:in:
+			 and:(currentClass withAllSubclasses)
+!
+methodLocalImplementors
+"launch an enterBox for selector to search for"
+self checkClassSelected ifFalse:[^ self].
+self askForSelectorTitle:'selector to browse local implementors of:'
+		    openWith:#browseImplementorsOf:under:
+			 and:currentClass
+!
+methodLocalSenders
+"launch an enterBox for selector to search for in current class & subclasses"
+self checkClassSelected ifFalse:[^ self].
+self askForSelectorTitle:'selector to browse local senders of:'
+		    openWith:#browseCallsOn:under:
+			 and:currentClass
+!
+methodLocalStringSearch
+"launch an enterBox for string to search for"
+self checkClassSelected ifFalse:[^ self].
+self askForSelectorTitle:'string to search for in local methods:'
+		    openWith:#browseForString:in:
+			 and:(currentClass withAllSubclasses)
+!
+methodLocalSuperSends
+"launch a browser showing super sends in current class & subclasses"
+self checkClassSelected ifFalse:[^ self].
+self withSearchCursorDo:[
+	SystemBrowser browseSuperCallsUnder:currentClass
+]
+"Created: 23.11.1995 / 12:03:57 / cg"
+"Modified: 23.11.1995 / 14:12:15 / cg"
+!
+methodMakePrivate
+"make the current method private.
+EXPERIMENTAL"
+self methodPrivacy:#private
+!
+methodMakeProtected
+"make the current method protected.
+EXPERIMENTAL"
+self methodPrivacy:#protected
+!
+methodMakePublic
+"make the current method public.
+EXPERIMENTAL"
+self methodPrivacy:#public
+!
+methodMenu
+"return a popupmenu as appropriate for the methodList"
+|m labels selectors
+newLabels newSelectors
+mthdLabels mthdSelectors
+brkLabels brkSelectors
+fileLabels fileSelectors
+searchLabels searchSelectors
+sepLocalLabels sepLocalSelectors
+localSearchLabels localSearchSelectors|
+device ctrlDown ifTrue:[
+	"/ 'secret' developpers menu
+	currentMethod isNil ifTrue:[
+	    methodListView flash.
+	    ^ nil
+	].
+	labels := #(
+			'inspect method'
+			'compile to machine code'
+			'decompile'
+			'-'
+			'make private'
+			'make protected'
+			'make public'
+		   ).
+	selectors := #(
+			methodInspect
+			methodSTCCompile
+			methodDecompile
+			nil
+			methodMakePrivate
+			methodMakeProtected
+			methodMakePublic
+		      )
+] ifFalse:[
+	sepLocalLabels := sepLocalSelectors := #().
+	searchLabels := #(
+				    'senders ...'
+				    'implementors ...'
+				    'globals ...'
+				    'string search ...'
+				    'apropos ...'
+			).
+	searchSelectors := #(
+				    methodSenders
+				    methodImplementors
+				    methodGlobalReferends
+				    methodStringSearch
+				    methodAproposSearch
+			    ).
+	currentClass notNil ifTrue:[
+	    localSearchLabels := #(
+				    '-'
+				    'local senders ...'
+				    'local implementors ...'
+				    'local super sends ...'
+				    'local string search ...'
+				    'local apropos ...'
+				).
+	    localSearchSelectors := #(
+				    nil
+				    methodLocalSenders
+				    methodLocalImplementors
+				    methodLocalSuperSends
+				    methodLocalStringSearch
+				    methodLocalAproposSearch
+				  ).
+	] ifFalse:[
+	    localSearchLabels := localSearchSelectors := #()
+	].
+	currentMethodCategory notNil ifTrue:[
+	    sepLocalLabels := #('-'). sepLocalSelectors := #(nil).
+	    newLabels :=           #(
+				    'new method'
+				    ).
+	    newSelectors :=    #(
+				    methodNewMethod
+				 ).
+	] ifFalse:[
+	    newLabels := newSelectors := #()
+	].
+	currentMethod notNil ifTrue:[
+	    fileLabels :=           #(
+				    'fileOut'
+				    'printOut'
+				    '-'
+				    'SPAWN_METHOD'
+				    '-'
+				    ).
+	    fileSelectors :=    #(
+				    methodFileOut
+				    methodPrintOut
+				    nil
+				    methodSpawn
+				    nil
+				 ).
+	    sepLocalLabels := #('-'). sepLocalSelectors := #(nil).
+	    mthdLabels :=           #(
+				    'change category ...'
+				    'remove'
+				    ).
+	    mthdSelectors :=    #(
+				    methodChangeCategory
+				    methodRemove
+				 ).
+	    currentMethod isWrapped ifTrue:[
+		brkLabels := #(
+				    'remove break/trace'
+				    '-'
+			      ).
+		brkSelectors := #(
+				    methodRemoveBreakOrTrace
+				    nil
+				 )
+	    ] ifFalse:[
+		brkLabels := #(
+				    'breakpoint'
+				    'trace'
+				    'trace sender'
+				    '-'
+			      ).
+		brkSelectors := #(
+				    methodBreakPoint
+				    methodTrace
+				    methodTraceSender
+				    nil
+				 )
+	    ]
+	] ifFalse:[
+	    fileLabels := fileSelectors := #().
+	    brkLabels := brkSelectors := #().
+	    mthdLabels := mthdSelectors := #().
+	].
+	labels :=
+		    fileLabels ,
+		    searchLabels ,
+		    localSearchLabels ,
+		    sepLocalLabels ,
+		    brkLabels ,
+		    newLabels ,
+		    mthdLabels.
+	selectors :=
+		    fileSelectors ,
+		    searchSelectors ,
+		    localSearchSelectors ,
+		    sepLocalSelectors ,
+		    brkSelectors ,
+		    newSelectors ,
+		    mthdSelectors.
+"
+	labels := #(
+				    'fileOut'
+				    'printOut'
+				    '-'
+				    'SPAWN_METHOD'
+				    '-'
+				    'senders ...'
+				    'implementors ...'
+				    'globals ...'
+				    'string search ...'
+				    'apropos ...'
+				    '-'
+				    'local senders ...'
+				    'local implementors ...'
+				    'local string search ...'
+				    'local apropos ...'
+				    '-'
+				    'breakpoint'
+				    'trace'
+				    'trace sender'
+				    '-'
+				    'new method'
+				    'change category ...'
+				    'remove'
+				).
+	 selectors := #(
+				    methodFileOut
+				    methodPrintOut
+				    nil
+				    methodSpawn
+				    nil
+				    methodSenders
+				    methodImplementors
+				    methodGlobalReferends
+				    methodStringSearch
+				    methodAproposSearch
+				    nil
+				    methodLocalSenders
+				    methodLocalImplementors
+				    methodLocalStringSearch
+				    methodLocalAproposSearch
+				    nil
+				    methodBreakPoint
+				    methodTrace
+				    methodTraceSender
+				    nil
+				    methodNewMethod
+				    methodChangeCategory
+				    methodRemove
+				  )
+"
+].
+m := PopUpMenu
+	 labels:(resources array:labels)
+	 selectors:selectors.
+currentMethod notNil ifTrue:[
+	currentMethod isPrivate ifTrue:[
+	    m disable:#methodMakePrivate
+	].
+	currentMethod isProtected ifTrue:[
+	    m disable:#methodMakeProtected
+	].
+	currentMethod isPublic ifTrue:[
+	    m disable:#methodMakePublic
+	].
+].
+currentMethod notNil ifTrue:[
+	(currentMethod code notNil
+	or:[Compiler canCreateMachineCode not]) ifTrue:[
+	    m disable:#methodSTCCompile
+	].
+	currentMethod byteCode isNil ifTrue:[
+	    m disable:#methodDecompile
+	].
+].
+^ m
+"Created: 23.11.1995 / 12:02:29 / cg"
+!
+methodNewMethod
+"prepare for definition of a new method - put a template into
+code view and define accept-action to compile it"
+currentClass isNil ifTrue:[
+	^ self warn:'select/create a class first'.
+].
+currentMethodCategory isNil ifTrue:[
+	^ self warn:'select/create a method category first'.
+].
+currentMethod := currentSelector := nil.
+methodListView deselect.
+codeView contents:(self template).
+codeView modified:false.
+self setAcceptAndExplainActionsForMethod.
+!
+methodPrintOut
+"print out the current method"
+|printStream|
+self checkMethodSelected ifFalse:[^ self].
+printStream := Printer new.
+actualClass printOutSource:(currentMethod source) on:printStream.
+printStream close
+!
+methodPrivacy:how
+"change the current methods privacy.
+EXPERIMENTAL"
+self checkMethodSelected ifFalse:[^ self].
+currentMethod isPublic ifFalse:[
+	currentMethod privacy:how.
+	actualClass updateRevisionString.
+	actualClass addChangeRecordForMethodPrivacy:currentMethod.
+	self updateMethodListWithScroll:false keepSelection:true.
+]
+"Created: 29.10.1995 / 20:00:00 / cg"
+!
+methodRemove
+"remove the current method"
+self checkMethodSelected ifFalse:[^ self].
+actualClass removeSelector:(actualClass selectorAtMethod:currentMethod).
+currentMethod := currentSelector := nil.
+self updateMethodListWithScroll:false
+!
+methodRemoveBreakOrTrace
+"turn off tracing of the current method"
+(currentMethod notNil and:[currentMethod isWrapped]) ifTrue:[
+	self commonTraceHelperWith:#unwrapMethod:
+]
+!
+methodSTCCompile
+"compile the current method to machine code.
+This is not supported on all machines, and never supported in
+the demo version."
+|prev|
+self checkMethodSelected ifFalse:[^ self].
+prev := Compiler stcCompilation:#always.
+[
+	codeView accept.
+] valueNowOrOnUnwindDo:[
+	Compiler stcCompilation:prev
+].
+!
+methodSenders
+"launch an enterBox for selector to search for"
+self askForSelectorTitle:'selector to browse senders of:'
+		    openWith:#browseAllCallsOn:
+!
+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 isMeta w|
+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:[
+			    SystemBrowser 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.
+	SystemBrowser browseClass:(w at:1) selector:(w at:2)
+]
+!
+methodStringSearch
+"launch an enterBox for string to search for"
+self askForSelectorTitle:'string to search for in sources:'
+		    openWith:#browseForString:
+!
+methodTrace
+"turn on tracing of the current method"
+currentClass notNil ifTrue:[
+currentSelector notNil ifTrue:[
+	  currentMethod := actualClass compiledMethodAt:currentSelector
+]
+].
+(currentMethod notNil and:[currentMethod isWrapped not]) ifTrue:[
+	self commonTraceHelperWith:#traceMethod:
+]
+!
+methodTraceSender
+"turn on tracing of the current method"
+(currentMethod notNil and:[currentMethod isWrapped not]) ifTrue:[
+	self commonTraceHelperWith:#traceMethodSender:
+]
+! !
+!BrowserView methodsFor:'method stuff'!
+checkMethodSelected
+currentMethod isNil ifTrue:[
+	self warn:'select a method first'.
+	^ false
+].
+^ true
+!
+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|
+newList := Set new.
+self classesInFullProtocolHierarchy:aClass do:[:c |
+	|searchCategory|
+	(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
+!
+listOfAllSelectorsInCategory:aCategory ofClass:aClass
+"answer a list of all selectors in a given method category
+of the argument, aClass"
+|newList searchCategory all p|
+all := (aCategory = '* all *').
+(aCategory = '* no category *') ifTrue:[
+	searchCategory := nil
+] ifFalse:[
+	searchCategory := aCategory
+].
+newList := OrderedCollection new.
+aClass methodArray with:aClass selectorArray do:[:aMethod :selector |
+	|sel how|
+	(all or:[aMethod category = searchCategory]) ifTrue:[
+	    sel := selector.
+	    (p := aMethod privacy) ~~ #public ifTrue:[
+		how := '    (* ' , p , ' *)'.
+	    ].
+	    aMethod isWrapped ifTrue:[
+		how := ' !!'
+	    ].
+	    aMethod isInvalid ifTrue:[
+		how := '    (** not executable **)'
+	    ].
+	    aMethod isLazyMethod ifTrue:[
+"/                how := '    (lazy)'
+	    ] ifFalse:[
+		(aMethod code isNil
+		and:[aMethod byteCode isNil]) ifTrue:[
+		    how := '    (** unloaded **)'
+		]
+	    ].
+	    how notNil ifTrue:[sel := sel , how].
+	    newList add:sel
+	]
+].
+(newList size == 0) ifTrue:[^ nil].
+^ newList sort
+"Modified: 28.8.1995 / 21:53:34 / claus"
+!
+methodSelection:lineNr
+"user clicked on a method line - show code"
+|selectorString selectorSymbol|
+(fullProtocol not and:[currentClass isNil]) ifTrue:[^ self].
+selectorString := methodListView selectionValue.
+"
+kludge: extract real selector
+"
+selectorString := selectorString withoutSpaces upTo:(Character space).
+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.
+		acceptClass := c
+	    ]
+	]
+] 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
+!
+methodSelectionChanged
+"method selection has changed - update dependent views"
+self withWaitCursorDo:[
+	|index cls|
+	self updateCodeView.
+	aspect := nil.
+	self setAcceptAndExplainActionsForMethod.
+	"
+	 if there is any autoSearch string, do the search
+	"
+	autoSearch notNil ifTrue:[
+	    codeView searchFwd:autoSearch startingAtLine:1 col:0 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
+		 and:[cls isMeta
+		 and:[cls name endsWith:'class']]) ifTrue:[
+		    index := classListView list indexOf:(cls name copyWithoutLast:5).
+		].
+		index ~~ 0 ifTrue:[
+		    classListView attributeAt:index add:#bold.
+		].
+		currentClass := acceptClass := cls.
+	    ]
+	].
+]
+"Created: 23.11.1995 / 14:17:44 / cg"
+!
+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 whichClassIncludesSelector:aSelector.
+	aClass notNil ifTrue:[
+	    nm := aClass name.
+	    showInstance ifFalse:[
+		((nm ~= 'Metaclass') and:[nm endsWith:'class']) ifTrue:[
+		    nm := nm copyWithoutLast:5 "copyTo:(nm size - 5)"
+		]
+	    ].
+	    self switchToClassNamed:nm.
+	    self switchToMethodNamed:aString
+	]
+]
+!
+switchToMethodNamed:matchString
+"switch (in the current class) to a method named matchString.
+If there are more than one matches, switch to the first."
+|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 updateMethodCategoryListWithScroll:false.
+	    self methodCategorySelectionChanged.
+	    currentMethod := classToSearch compiledMethodAt:aSelector.
+	    currentMethod notNil ifTrue:[
+		currentSelector := aSelector.
+		methodListView selectElement:aSelector.
+	    ].
+	    self methodSelectionChanged
+	]
+]
+!
+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''.
+"
+'
+!
+updateMethodList
+self updateMethodListWithScroll:true keepSelection:false
+!
+updateMethodListWithScroll:scroll
+self updateMethodListWithScroll:scroll keepSelection:false
+!
+updateMethodListWithScroll:scroll keepSelection:keep
+|selectors scr first last selection|
+methodListView notNil ifTrue:[
+	selection := methodListView selection.
+	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
+	    ]
+	].
+	keep ifTrue:[
+	    methodListView selection:selection.
+	]
+]
+! !
+!BrowserView methodsFor:'misc'!
+instanceProtocol:aBoolean
+"switch between instance and class protocol"
+|onToggle offToggle|
+showInstance ~~ aBoolean ifTrue:[
+	self checkSelectionChangeAllowed ifTrue:[
+	    instanceToggle notNil ifTrue:[
+		aBoolean ifTrue:[
+		    offToggle := classToggle.
+		    onToggle := instanceToggle.
+		] ifFalse:[
+		    onToggle := classToggle.
+		    offToggle := instanceToggle.
+		].
+		onToggle turnOn.
+		offToggle turnOff.
+	    ].
+	    showInstance := aBoolean.
+	    (variableListView notNil
+	    and:[variableListView hasSelection]) ifTrue:[
+		self unhilightMethodCategories.
+		self unhilightMethods.
+		variableListView deselect
+	    ].
+	    fullProtocol ifTrue:[
+		showInstance ifTrue:[
+		    actualClass := currentClassHierarchy.
+		] ifFalse:[
+		    actualClass := currentClassHierarchy class.
+		].
+		acceptClass := actualClass.
+		self updateClassList.
+		self updateMethodCategoryListWithScroll:false.
+		self updateMethodListWithScroll:false.
+		self updateVariableList.
+		^ self
+	    ].
+	    currentClass notNil ifTrue:[
+		self classSelectionChanged
+	    ].
+	    codeView modified:false.
+	] ifFalse:[
+	    aBoolean ifTrue:[
+		onToggle := classToggle.
+		offToggle := instanceToggle
+	    ] ifFalse:[
+		offToggle := classToggle.
+		onToggle := instanceToggle.
+	    ].
+	    onToggle turnOn.
+	    offToggle turnOff.
+	]
+]
+!
+processName
+"the name of my process - for the processMonitor only"
+^ 'System Browser'.
+!
+updateCodeView
+|code|
+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.
+"Created: 23.11.1995 / 14:16:43 / cg"
+"Modified: 23.11.1995 / 14:19:25 / cg"
+! !
+!BrowserView methodsFor:'private'!
+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
+!
+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
+!
+askForSelectorTitle:title
+"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 | aString isEmpty ifTrue:[^ nil]. ^ aString].
+box showAtPointer.
+^ nil
+!
+askForSelectorTitle:title openWith:selector
+"convenient method: setup enterBox with text from codeView or selected
+method for browsing based on a selector. Set action and launch box"
+|string|
+string := self askForSelectorTitle:title.
+string notNil ifTrue:[
+	self withSearchCursorDo:[
+	    SystemBrowser perform:selector with:string
+	]
+].
+"Created: 23.11.1995 / 14:11:34 / cg"
+!
+askForSelectorTitle:title openWith:selector and:arg
+"convenient method: setup enterBox with text from codeView or selected
+method for browsing based on a selector. Set action and launch box"
+|string|
+string := self askForSelectorTitle:title.
+string notNil ifTrue:[
+	self withSearchCursorDo:[
+	    SystemBrowser perform:selector with:string with:arg
+	]
+].
+"Created: 23.11.1995 / 14:11:38 / cg"
+!
+busyLabel:what with:someArgument
+"set the title for some warning"
+self label:('System Browser - ' , (resources string:what with:someArgument))
+!
+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"
+|what m src v|
+currentMethod notNil ifTrue:[
+	m := actualClass compiledMethodAt:currentSelector.
+	m notNil ifTrue:[
+	    (src := m source) = codeView contents ifFalse:[
+		what := self checkSelectionChangeAllowedWithCompare:true.
+		what == #compare ifTrue:[
+		    v := DiffTextView
+			    openOn:codeView contents label:'code here (to be accepted ?)'
+			    and:src label:'methods actual code'.
+		    v label:'comparing method versions'.
+		    ^ false
+		].
+		^ what
+	    ]
+	]
+].
+^ self checkSelectionChangeAllowedWithCompare:false
+"Created: 24.11.1995 / 11:03:33 / cg"
+"Modified: 24.11.1995 / 11:05:49 / cg"
+!
+checkSelectionChangeAllowedWithCompare:compareOffered
+"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"
+|action labels values|
+codeView modified ifFalse:[
+	^ true
+].
+compareOffered ifTrue:[
+	labels := #('abort' 'compare' 'accept' 'continue').
+	values := #(false #compare #accept true).
+] ifFalse:[
+	labels := #('abort' 'accept' 'continue').
+	values := #(false #accept true).
+].
+action := OptionBox
+		  request:(resources at:'text has not been accepted.\\Your modifications will be lost when continuing.') withCRs
+		  label:(resources string:'Attention')
+		  form:(WarningBox iconBitmap)
+		  buttonLabels:(resources array:labels)
+		  values:values
+		  default:true.
+action ~~ #accept ifTrue:[
+	^ action
+].
+codeView accept.
+^ true
+"Created: 24.11.1995 / 10:54:46 / cg"
+!
+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
+	]
+]
+!
+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
+]
+!
+classesInHierarchy:aClass do:aBlock
+|index|
+index := (classListView list size).
+aClass withAllSuperclasses do:[:c |
+	(classListView isInSelection:index) ifFalse:[
+	    aBlock value:c
+	].
+	index := index - 1
+]
+!
+compileCode:someCode
+(ReadStream on:someCode) fileIn
+!
+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 |
+	aString notEmpty ifTrue:[
+	    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
+!
+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
+!
+enterBoxTitle:title okText:okText
+"convenient method: setup enterBox"
+|box|
+box := EnterBox new.
+box title:(resources string:title) okText:(resources string:okText).
+^ box
+!
+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 copyWithoutLast:5 "copyTo:(clsName size - 5)"
+	    ] ifFalse:[
+		isMeta := false
+	    ].
+	]
+].
+aBlock value:clsName value:sel value:isMeta
+!
+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
+!
+listBoxForCodeSelectionTitle:title okText:okText
+"convenient method: setup listBox with text from codeview"
+|sel box|
+box := self listBoxTitle:title okText:okText list:nil.
+sel := codeView selection.
+sel notNil ifTrue:[
+	box initialText:(sel asString withoutSeparators)
+].
+^ box
+!
+listBoxTitle:title okText:okText list:aList
+"convenient method: setup a listBox & return it"
+|box|
+box := ListSelectionBox
+		title:(resources string:title)
+		okText:(resources string:okText)
+		action:nil.
+box list:aList.
+^ box
+!
+normalLabel
+"set the normal (inactive) window- and icon labels"
+|l il|
+myLabel notNil ifTrue:[
+	"if I have been given an explicit label,
+	 and its not the default, take that one"
+	myLabel ~= 'System Browser' ifTrue:[
+	    l := il := myLabel
+	]
+].
+l isNil ifTrue:[
+	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.
+!
+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 upTo:(Character space)
+	] ifFalse:[
+	    sel := ''
+	]
+].
+^ sel
+!
+setAcceptAndExplainActionsForMethod
+"tell the codeView what to do on accept and explain"
+codeView acceptAction:[:theCode |
+	|cat cls|
+	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:[
+	    fullProtocol ifTrue:[
+		cls := acceptClass "/actualClass whichClassIncludesSelector:currentSelector.
+	    ].
+	    cls isNil ifTrue:[
+		cls := actualClass
+	    ].
+	    Object abortSignal catch:[
+		lockUpdates := true.
+		actualClass compilerClass
+		    compile:theCode asString
+		    forClass:cls
+		    inCategory:cat
+		    notifying:codeView.
+		codeView modified:false.
+		self updateMethodListWithScroll:false.
+		currentMethod := actualClass compiledMethodAt:currentSelector.
+	    ].
+	    lockUpdates := false.
+	].
+	codeView cursor:Cursor normal.
+].
+codeView explainAction:[:theCode :theSelection |
+	self showExplanation:(Explainer
+				explain:theSelection
+				in:theCode
+				forClass:actualClass)
+].
+!
+setDoitActionForClass
+"tell the codeView what to do on doIt"
+"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 evaluatorClass
+	].
+	compiler
+	    evaluate:theCode
+	    in:nil
+	    receiver:currentClass
+	    notifying:codeView
+	    logged:false
+	    ifFail:nil
+].
+!
+setSearchPattern:aString
+codeView setSearchPattern:aString
+!
+showExplanation:someText
+"show explanation from Parser"
+self information: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
+!
+warnLabel:what
+"set the title for some warning"
+self label:('System Browser WARNING: ' , what)
+!
+withSearchCursorDo:aBlock
+^ self withCursor:(Cursor questionMark) do:aBlock
+"Created: 23.11.1995 / 14:11:14 / cg"
+! !
+!BrowserView methodsFor:'unused'!
+listOfAllMethodCategoriesInHierarchy:aClass
+"answer a list of all method categories of the argument, aClass,
+and all of its superclasses"
+|newList cat|
+newList := Set new.
+self classesInHierarchy:aClass do:[:c |
+	c methodArray do:[:aMethod |
+	    cat := aMethod category.
+	    cat isNil ifTrue:[
+		cat := '* no category *'
+	    ].
+	    newList add:cat
+	]
+].
+(newList size == 0) ifTrue:[^ nil].
+newList add:'* all *'.
+^ newList asOrderedCollection sort
+!
+listOfAllSelectorsInCategory:aCategory inHierarchyOfClass:aClass
+"answer a list of all selectors in a given method category
+of the argument, aClass and its superclasses"
+|newList|
+newList := Set new.
+self classesInHierarchy:aClass do:[:c |
+	|searchCategory|
+	(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
+! !
+!BrowserView methodsFor:'variable list menu'!
+allClassOrInstVarRefsTitle:title access:access mods:modifications
+"show an enterbox for instVar to search for"
+self doClassMenu:[:currentClass |
+	|box|
+	box := self enterBoxForVariableSearch:title.
+	box action:[:aVariableName |
+	    |homeClass|
+	    aVariableName isEmpty ifFalse:[
+		self withSearchCursorDo:[
+		    homeClass := self findClassOfVariable:aVariableName accessWith:access.
+		    access == #classVarNames ifTrue:[
+			SystemBrowser
+			    browseClassRefsTo:aVariableName
+			    under:homeClass
+			    modificationsOnly:modifications
+		    ] ifFalse:[
+			SystemBrowser
+			    browseInstRefsTo:aVariableName
+			    under:homeClass
+			    modificationsOnly:modifications
+		    ]
+		]
+	    ]
+	].
+	box showAtPointer
+]
+"Created: 23.11.1995 / 14:13:24 / cg"
+!
+allClassVarMods
+"show an enterbox for classVar to search for"
+self allClassOrInstVarRefsTitle:'class variable to browse modifications of:'
+				  access:#classVarNames
+				  mods:true
+!
+allClassVarRefs
+"show an enterbox for classVar to search for"
+self allClassOrInstVarRefsTitle:'class variable to browse references to:'
+				  access:#classVarNames
+				  mods:false
+!
+allInstVarMods
+"show an enterbox for instVar to search for"
+self allClassOrInstVarRefsTitle:'instance variable to browse modifications of:'
+				  access:#instVarNames
+				  mods:true
+!
+allInstVarRefs
+"show an enterbox for instVar to search for"
+self allClassOrInstVarRefsTitle:'instance variable to browse references to:'
+				  access:#instVarNames
+				  mods:false
+!
+classVarMods
+"show an enterbox for classVar to search for"
+self classVarRefsOrModsTitle:'class variable to browse modifications of:'
+				 mods:true
+!
+classVarRefs
+"show an enterbox for classVar to search for"
+self classVarRefsOrModsTitle:'class variable to browse references to:'
+				 mods:false
+!
+classVarRefsOrModsTitle:title mods:mods
+"show an enterbox for classVar to search for"
+self doClassMenu:[:currentClass |
+	|box|
+	box := self enterBoxForVariableSearch:title.
+	box action:[:aString |
+	    aString notEmpty ifTrue:[
+		self withSearchCursorDo:[
+		    SystemBrowser
+			   browseClassRefsTo:aString
+			   in:(Array with:currentClass)
+			   modificationsOnly:mods
+		]
+	    ]
+	].
+	box showAtPointer
+]
+"Created: 23.11.1995 / 14:12:56 / cg"
+!
+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
+!
+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
+!
+instVarRefsOrModsTitle:title mods:mods
+"show an enterbox for instvar to search for"
+self doClassMenu:[:currentClass |
+	|box|
+	box := self enterBoxForVariableSearch:title.
+	box action:[:aString |
+	    aString notEmpty ifTrue:[
+		self withSearchCursorDo:[
+		    SystemBrowser
+			browseInstRefsTo:aString
+			in:(Array with:currentClass)
+			modificationsOnly:mods
+		]
+	    ]
+	].
+	box showAtPointer
+]
+"Created: 23.11.1995 / 14:12:40 / cg"
+!
+varTypeInfo
+"show typical usage of a variable"
+|name idx classes values value msg cut names instCount subInstCount box
+searchClass|
+name := variableListView selectionValue.
+name isNil ifTrue:[^ self].
+searchClass := actualClass whichClassDefinesInstVar:name.
+idx := searchClass instVarOffsetOf:name.
+idx isNil ifTrue:[^ self].
+classes := IdentitySet new.
+values := IdentitySet new.
+instCount := 0.
+subInstCount := 0.
+searchClass allSubInstancesDo:[:i |
+	|val|
+	val := i instVarAt:idx.
+	val notNil ifTrue:[values add:val].
+	classes add:val class.
+	(i isMemberOf:searchClass) ifTrue:[
+	    instCount := instCount + 1.
+	] ifFalse:[
+	    subInstCount := subInstCount + 1
+	]
+].
+(instCount == 0 and:[subInstCount == 0]) ifTrue:[
+	self warn:'there are currently no instances of ' , currentClass name.
+	^ self
+].
+instCount ~~ 0 ifTrue:[
+	msg := 'in (currently: ' , instCount printString,') instances '.
+	subInstCount ~~ 0 ifTrue:[
+	    msg := msg , 'and '
+	]
+] ifFalse:[
+	msg := 'in '.
+].
+subInstCount ~~ 0 ifTrue:[
+	msg := msg , '(currently: ' , subInstCount printString, ') derived instances '
+].
+msg := msg, 'of ' , searchClass name , ',\'.
+msg := msg , name , ' '.
+((values size == 1)
+or:[classes size == 1 and:[classes first == UndefinedObject]]) ifTrue:[
+	values size == 1 ifTrue:[value := values first].
+	(value isNumber or:[value isString]) ifTrue:[
+	    msg := msg , 'is always the same:\\      ' ,
+			 value class name , ' (' , value storeString , ')'.
+	] ifFalse:[
+	    (value isNil or:[value == true or:[value == false]]) ifTrue:[
+		msg := msg , 'is always:\\      ' ,
+			     value printString.
+	    ] ifFalse:[
+		msg := msg , 'is always the same:\\'.
+		msg := msg , '      ' , value class name.
+		value isLiteral ifTrue:[
+		    msg := msg , ' (' , value storeString , ')'
+		]
+	    ]
+	]
+] ifFalse:[
+	classes size == 1 ifTrue:[
+	    msg := msg , 'is always:\\'.
+	    msg := msg , '      ' , classes first name , '\'.
+	] ifFalse:[
+	    msg := msg , 'is one of:\\'.
+	    classes := classes asOrderedCollection.
+	    classes size > 20 ifTrue:[
+		classes := classes copyFrom:1 to:20.
+		cut := true
+	    ] ifFalse:[
+		cut := false.
+	    ].
+	    names := classes collect:[:cls |
+		|nm|
+		cls == UndefinedObject ifTrue:[
+		    'nil'
+		] ifFalse:[
+		    cls == True ifTrue:[
+			'true'
+		    ] ifFalse:[
+			cls == False ifTrue:[
+			    'false'
+			] ifFalse:[
+			    cls name
+			]
+		    ]
+		].
+	    ].
+	    names sort.
+	    names do:[:nm |
+		msg := msg , '      ' , nm , '\'.
+	    ].
+	]
+].
+box := InfoBox title:msg withCRs.
+box label:'variable type information'.
+box showAtPointer
+!
+variableListMenu
+|labels selectors|
+currentClass isNil ifTrue:[
+	variableListView flash.
+	^ nil
+].
+labels := #(
+		    '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
+		 ).
+(showInstance and:[variableListView hasSelection]) ifTrue:[
+	labels := labels , #(
+				'-'
+				'type information'
+			   ).
+	selectors := selectors , #(
+				nil
+				varTypeInfo
+				).
+].
+^ PopUpMenu labels:(resources array:labels)
+		selectors:selectors
+!
+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.
+! !
+!BrowserView methodsFor:'variable stuff'!
+hilightMethodsInMethodCategoryList
+"search for methods  which access the selected
+variable, and highlight them"
+self hilightMethodsInMethodCategoryList:true inMethodList:false
+!
+hilightMethodsInMethodCategoryList:inCat inMethodList:inMethods
+"search for methods  which access the selected
+variable, and highlight them"
+|name 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 withSearchCursorDo:[
+	|classes filter any|
+	classes := Array with:actualClass.
+	currentClassHierarchy notNil ifTrue:[
+	    classes := classes , actualClass allSuperclasses.
+	    redefinedSelectors := IdentitySet new.
+	].
+	filter := SystemBrowser filterToSearchRefsTo:name classVars:showInstance not modificationsOnly:false.
+	any := false.
+	"
+	 highlight the method that ref this variable
+	"
+	classes do:[:someClass |
+	    (fullProtocol
+	    and:[classListView valueIsInSelection:(someClass name)]) ifFalse:[
+		someClass methodArray with:someClass selectorArray
+		do:[:method :selector |
+		    (inCat
+		    or:[methodListView list notNil
+			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
+	]
+]
+"Created: 23.11.1995 / 14:12:08 / cg"
+!
+hilightMethodsInMethodList
+"search for methods  which access the selected
+variable, and highlight them"
+self hilightMethodsInMethodCategoryList:false inMethodList:true
+!
+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.
+	]
+].
+!
+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.
+	].
+].
+!
+updateVariableList
+|l subList last nameAccessSelector class oldSelection|
+variableListView isNil ifTrue:[^ self].
+oldSelection := variableListView selectionValue.
+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 := currentClassHierarchy notNil ifTrue:[currentClassHierarchy] ifFalse:[currentClass].
+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.
+	self hilightMethodsInMethodCategoryList:true inMethodList:true.
+]
+! !
 !BrowserView class methodsFor:'documentation'!
 version
-^ '$Header: /cvs/stx/stx/libtool/BrowserView.st,v 1.57 1995-12-07 10:17:26 cg Exp $'! !
+^ '$Header: /cvs/stx/stx/libtool/BrowserView.st,v 1.58 1995-12-07 12:26:14 cg Exp $'! !
 BrowserView initialize!

changeset 246	9f1583be2b81
parent 244	94e45bedcdf0
child 247	d24056597bbf