'From Squeak3.9alpha of 4 July 2005 [latest update: #7045] on 18 July 2006 at 9:06:05 pm'!
Model subclass: #Browser
	instanceVariableNames: 'systemOrganizer classOrganizer metaClassOrganizer systemCategoryListIndex classListIndex messageCategoryListIndex messageListIndex editSelection metaClassIndicated'
	classVariableNames: 'RecentClasses'
	poolDictionaries: ''
	category: 'Tools-Browser'!
!Browser commentStamp: '<historical>' prior: 0!
I represent a query path into the class descriptions, the software of the system.!


!Browser methodsFor: 'accessing' stamp: 'al 12/6/2005 22:36'!
contents
	"Depending on the current selection, different information is retrieved.
	Answer a string description of that information. This information is the
	method of the currently selected class and message."

	| comment theClass latestCompiledMethod |
	latestCompiledMethod _ currentCompiledMethod.
	currentCompiledMethod _ nil.

	editSelection == #newTrait
		ifTrue: [^Trait newTemplateIn: self selectedSystemCategoryName].
	editSelection == #none ifTrue: [^ ''].
	editSelection == #editSystemCategories 
		ifTrue: [^ systemOrganizer printString].
	editSelection == #newClass 
		ifTrue: [^ (theClass _ self selectedClass)
			ifNil:
				[Class template: self selectedSystemCategoryName]
			ifNotNil:
				[Class templateForSubclassOf: theClass category: self selectedSystemCategoryName]].
	editSelection == #editClass 
		ifTrue: [^self classDefinitionText].
	editSelection == #editComment 
		ifTrue:
			[(theClass _ self selectedClass) ifNil: [^ ''].
			comment _ theClass comment.
			currentCompiledMethod _ theClass organization commentRemoteStr.
			^ comment size = 0
				ifTrue: ['This class has not yet been commented.']
				ifFalse: [comment]].
	editSelection == #hierarchy 
		ifTrue: [
			self selectedClassOrMetaClass isTrait
				ifTrue: [^'']
				ifFalse: [^self selectedClassOrMetaClass printHierarchy]].
	editSelection == #editMessageCategories 
		ifTrue: [^ self classOrMetaClassOrganizer printString].
	editSelection == #newMessage
		ifTrue:
			[^ (theClass _ self selectedClassOrMetaClass) 
				ifNil: ['']
				ifNotNil: [theClass sourceCodeTemplate]].
	editSelection == #editMessage
		ifTrue:
			["self showingByteCodes ifTrue: [^ self selectedBytecodes]."
			currentCompiledMethod _ latestCompiledMethod.
			^ self selectedMessage].

	self error: 'Browser internal error: unknown edit selection.'! !

!Browser methodsFor: 'accessing' stamp: 'drs 1/6/2003 16:11'!
contentsSelection
	"Return the interval of text in the code pane to select when I set the pane's contents"

	messageCategoryListIndex > 0 & (messageListIndex = 0)
		ifTrue: [^ 1 to: 500]	"entire empty method template"
		ifFalse: [^ 1 to: 0]  "null selection"! !

!Browser methodsFor: 'accessing' stamp: 'drs 1/6/2003 16:11'!
superCategoryOfCurrentMethod
	"Answer the category that owns the current method.  If unable to determine a category, answer nil."

	| aClass aSelector |
	^ (aClass := self selectedClassOrMetaClass) 
		ifNotNil: [(aSelector := self selectedMessageName) 
			            ifNotNil: [aClass whichCategoryIncludesSelector: aSelector]]! !

!Browser methodsFor: 'accessing' stamp: 'al 4/24/2004 12:01'!
contents: input notifying: aController 
	"The retrieved information has changed and its source must now be
	 updated. The information can be a variety of things, depending on
	 the list selections (such as templates for class or message definition,
	 methods) or the user menu commands (such as definition, comment,
	 hierarchy).  Answer the result of updating the source."

	| aString aText theClass |
	self changed: #annotation.
	aString _ input asString.
	aText _ input asText.
	editSelection == #newTrait ifTrue: [^self defineTrait: input asString notifying: aController].
	editSelection == #editSystemCategories ifTrue: [^ self changeSystemCategories: aString].
	editSelection == #editClass | (editSelection == #newClass) ifTrue: [^ self defineClass: aString notifying: aController].
	editSelection == #editComment
		ifTrue: 
			[theClass _ self selectedClass.
			theClass
				ifNil: 
					[self inform: 'You must select a class
before giving it a comment.'.
					^ false].
			theClass comment: aText stamp: Utilities changeStamp.
			self changed: #classCommentText.
			^ true].
	editSelection == #hierarchy ifTrue: [^ true].
	editSelection == #editMessageCategories ifTrue: [^ self changeMessageCategories: aString].
	editSelection == #editMessage | (editSelection == #newMessage)
		ifTrue:
			[^ self compileMessage: aText notifying: aController].
	editSelection == #none
		ifTrue: 
			[self inform: 'This text cannot be accepted
in this part of the browser.'.
			^ false].
	self error: 'unacceptable accept'! !

!Browser methodsFor: 'accessing' stamp: 'di 6/21/1998 22:20'!
couldBrowseAnyClass
	"Answer whether the receiver is equipped to browse any class. This is in support of the system-brower feature that allows the browser to be redirected at the selected class name.  This implementation is clearly ugly, but the feature it enables is handsome enough.  3/1/96 sw"

	self dependents
		detect: [:d |
			((d isKindOf: PluggableListView) or: [d isKindOf: PluggableListMorph]) and: 
			[d getListSelector == #systemCategoryList]]
		ifNone: [^ false].
	^ true
! !

!Browser methodsFor: 'accessing' stamp: 'sma 5/28/2000 11:28'!
doItReceiver
	"This class's classPool has been jimmied to be the classPool of the class 
	being browsed. A doIt in the code pane will let the user see the value of 
	the class variables."

	^ self selectedClass ifNil: [FakeClassPool new]! !

!Browser methodsFor: 'accessing'!
editSelection
	^editSelection! !

!Browser methodsFor: 'accessing' stamp: 'sd 11/20/2005 21:26'!
editSelection: aSelection
	"Set the editSelection as requested."

	editSelection := aSelection.
	self changed: #editSelection.! !

!Browser methodsFor: 'accessing' stamp: 'sd 11/20/2005 21:26'!
noteSelectionIndex: anInteger for: aSymbol
	aSymbol == #systemCategoryList
		ifTrue:
			[systemCategoryListIndex := anInteger].
	aSymbol == #classList
		ifTrue:
			[classListIndex := anInteger].
	aSymbol == #messageCategoryList
		ifTrue:
			[messageCategoryListIndex := anInteger].
	aSymbol == #messageList
		ifTrue:
			[messageListIndex := anInteger].! !

!Browser methodsFor: 'accessing' stamp: 'rbb 3/1/2005 10:26'!
request: prompt initialAnswer: initialAnswer

	^ UIManager default
		request: prompt
		initialAnswer: initialAnswer
! !

!Browser methodsFor: 'accessing' stamp: 'sw 1/4/2001 12:24'!
spawn: aString 
	"Create and schedule a fresh browser and place aString in its code pane.  This method is called when the user issues the #spawn command (cmd-o) in any code pane.  Whatever text was in the original code pane comes in to this method as the aString argument; the changes in the original code pane have already been cancelled by the time this method is called, so aString is the only copy of what the user had in his code pane."

	self selectedClassOrMetaClass ifNotNil: [^ super spawn: aString].

	systemCategoryListIndex ~= 0
		ifTrue:
			["This choice is slightly useless but is the historical implementation"
			^ self buildSystemCategoryBrowserEditString: aString].
		
	^ super spawn: aString  
	"This bail-out at least saves the text being spawned, which would otherwise be lost"! !

!Browser methodsFor: 'accessing' stamp: 'sw 9/26/2002 17:56'!
suggestCategoryToSpawnedBrowser: aBrowser
	"aBrowser is a message-category browser being spawned from the receiver.  Tell it what it needs to know to get its category info properly set up."

	(self isMemberOf: Browser) "yecch, but I didn't invent the browser hierarchy"
		ifTrue:
			[aBrowser messageCategoryListIndex: (self messageCategoryList indexOf: self categoryOfCurrentMethod ifAbsent: [2])]
		ifFalse:
			[aBrowser setOriginalCategoryIndexForCurrentMethod]! !


!Browser methodsFor: 'annotation' stamp: 'sd 11/20/2005 21:26'!
annotation
	"Provide a line of content for an annotation pane, representing information about the method associated with the selected class and selector in the receiver."

	|  aSelector aClass |
	(aClass := self selectedClassOrMetaClass) == nil ifTrue: [^ '------'].
	self editSelection == #editComment ifTrue:
		[^ self annotationForSelector: #Comment ofClass: aClass].

	self editSelection == #editClass ifTrue:
		[^ self annotationForSelector: #Definition ofClass: aClass].
	(aSelector := self selectedMessageName) ifNil: [^ '------'].
	^ self annotationForSelector: aSelector ofClass: aClass! !


!Browser methodsFor: 'breakpoints' stamp: 'emm 5/30/2002 09:23'!
toggleBreakOnEntry
	"Install or uninstall a halt-on-entry breakpoint"

	| selectedMethod |
	self selectedClassOrMetaClass isNil ifTrue:[^self].
	selectedMethod := self selectedClassOrMetaClass >> self selectedMessageName.
	selectedMethod hasBreakpoint
		ifTrue:
			[BreakpointManager unInstall: selectedMethod]
		ifFalse:
			[BreakpointManager 
				installInClass: self selectedClassOrMetaClass
				selector: self selectedMessageName].
	self changed: #messageList
		! !


!Browser methodsFor: 'class comment pane' stamp: 'nk 2/15/2004 13:20'!
buildMorphicCommentPane
	"Construct the pane that shows the class comment.
	Respect the Preference for standardCodeFont."

	| commentPane |
	commentPane := BrowserCommentTextMorph
				on: self
				text: #classCommentText
				accept: #classComment:notifying:
				readSelection: nil
				menu: #codePaneMenu:shifted:.
	commentPane font: Preferences standardCodeFont.
	^ commentPane! !

!Browser methodsFor: 'class comment pane' stamp: 'dew 3/5/2005 23:10'!
classComment: aText notifying: aPluggableTextMorph 
	"The user has just entered aText.
	It may be all red (a side-effect of replacing the default comment), so remove the color if it is."

	| theClass cleanedText redRange |
	theClass := self selectedClassOrMetaClass.
	theClass
		ifNotNil: [cleanedText := aText asText.
			redRange := cleanedText rangeOf: TextColor red startingAt: 1.
			redRange size = cleanedText size
				ifTrue: [cleanedText
						removeAttribute: TextColor red
						from: 1
						to: redRange last ].
			theClass comment: aText stamp: Utilities changeStamp].
	self changed: #classCommentText.
	^ true! !

!Browser methodsFor: 'class comment pane' stamp: 'md 2/24/2006 15:23'!
noCommentNagString

	^ Text string: 'THIS CLASS HAS NO COMMENT!!' translated attribute: TextColor red.
		! !


!Browser methodsFor: 'class functions' stamp: 'sd 11/20/2005 21:26'!
addAllMethodsToCurrentChangeSet
	"Add all the methods in the selected class or metaclass to the current change set.  You ought to know what you're doing before you invoke this!!"

	| aClass |
	(aClass := self selectedClassOrMetaClass) ifNotNil:
		[aClass selectors do:
			[:sel |
				ChangeSet current adoptSelector: sel forClass: aClass].
		self changed: #annotation]
! !

!Browser methodsFor: 'class functions'!
buildClassBrowser
	"Create and schedule a new class category browser for the current class 
	selection, if one exists."

	self buildClassBrowserEditString: nil! !

!Browser methodsFor: 'class functions' stamp: 'sd 11/20/2005 21:26'!
classCommentText
	"return the text to display for the comment of the currently selected class"
	| theClass |
	theClass := self selectedClassOrMetaClass.
	theClass ifNil: [ ^''].

	^ theClass hasComment
		ifTrue: [  theClass comment  ]
		ifFalse: [ self noCommentNagString ]! !

!Browser methodsFor: 'class functions' stamp: 'sd 11/20/2005 21:26'!
classDefinitionText
	"return the text to display for the definition of the currently selected class"
	| theClass |
	theClass := self selectedClassOrMetaClass.
	theClass ifNil: [ ^''].

	^theClass definitionST80.! !

!Browser methodsFor: 'class functions' stamp: 'sw 12/6/2000 16:32'!
classListMenu: aMenu 
	"For backward compatibility with old browers stored in image segments"

	^ self classListMenu: aMenu shifted: false! !

!Browser methodsFor: 'class functions' stamp: 'md 2/18/2006 16:23'!
classListMenu: aMenu shifted: shifted
	"Set up the menu to apply to the receiver's class list, honoring the #shifted boolean"

	ServiceGui browser: self classMenu: aMenu.
	Preferences useOnlyServicesInMenu ifTrue: [^aMenu].
	shifted ifTrue: [^ self shiftedClassListMenu: aMenu].
	self addSpecialMenu: aMenu.
	aMenu addList: #(
		-
		('browse full (b)'			browseMethodFull)
		('browse hierarchy (h)'		spawnHierarchy)
		('browse protocol (p)'		browseFullProtocol)
		-
		('printOut'					printOutClass)
		('fileOut'					fileOutClass)
		-
		('show hierarchy'			hierarchy)
		('show definition'			editClass)
		('show comment'			editComment)
		-
		('inst var refs...'			browseInstVarRefs)
		('inst var defs...'			browseInstVarDefs)
		-
		('class var refs...'			browseClassVarRefs)
		('class vars'					browseClassVariables)
		('class refs (N)'				browseClassRefs)
		-
		('rename class ...'			renameClass)
		('copy class'				copyClass)
		('remove class (x)'			removeClass)
		-
		('find method...'				findMethod)
		('find method wildcard...'				findMethodWithWildcard)
		-
		('more...'					offerShiftedClassListMenu)).
	^ aMenu
! !

!Browser methodsFor: 'class functions' stamp: 'sd 11/20/2005 21:26'!
copyClass
	| originalName copysName class oldDefinition newDefinition |
	classListIndex = 0 ifTrue: [^ self].
	self okToChange ifFalse: [^ self].
	originalName := self selectedClass name.
	copysName := self request: 'Please type new class name' initialAnswer: originalName.
	copysName = '' ifTrue: [^ self].  " Cancel returns '' "
	copysName := copysName asSymbol.
	copysName = originalName ifTrue: [^ self].
	(Smalltalk includesKey: copysName)
		ifTrue: [^ self error: copysName , ' already exists'].
	oldDefinition := self selectedClass definition.
	newDefinition := oldDefinition copyReplaceAll: '#' , originalName asString with: '#' , copysName asString.
	Cursor wait 
		showWhile: [class := Compiler evaluate: newDefinition logged: true.
					class copyAllCategoriesFrom: (Smalltalk at: originalName).
					class class copyAllCategoriesFrom: (Smalltalk at: originalName) class].
	self classListIndex: 0.
	self changed: #classList! !

!Browser methodsFor: 'class functions' stamp: 'sd 11/20/2005 21:30'!
createInstVarAccessors
	"Create getters and setters for all inst vars defined at the level of the current class selection, except do NOT clobber or override any selectors already understood by the instances of the selected class"

	| aClass newMessage setter |
	(aClass := self selectedClassOrMetaClass) ifNotNil:
		[aClass instVarNames do: 
			[:aName |
				(aClass canUnderstand: aName asSymbol)
					ifFalse:
						[newMessage := aName, '
	"Answer the value of ', aName, '"

	^ ', aName.
						aClass compile: newMessage classified: 'accessing' notifying: nil].
				(aClass canUnderstand: (setter := aName, ':') asSymbol)
					ifFalse:
						[newMessage := setter, ' anObject
	"Set the value of ', aName, '"

	', aName, ' := anObject'.
						aClass compile: newMessage classified: 'accessing' notifying: nil]]]! !

!Browser methodsFor: 'class functions' stamp: 'md 3/3/2006 11:02'!
defineClass: defString notifying: aController  
	"The receiver's textual content is a request to define a new class. The
	source code is defString. If any errors occur in compilation, notify
	aController."
	| oldClass class newClassName defTokens keywdIx envt |
	oldClass _ self selectedClassOrMetaClass.
	defTokens _ defString findTokens: Character separators.
	
	((defTokens first = 'Trait' and: [defTokens second = 'named:'])
		or: [defTokens second = 'classTrait'])
		ifTrue: [^self defineTrait: defString notifying: aController].
		
	keywdIx _ defTokens findFirst: [:x | x beginsWith: 'category'].
	envt _ Smalltalk.
	keywdIx _ defTokens findFirst: [:x | '*subclass*' match: x].
	newClassName _ (defTokens at: keywdIx+1) copyWithoutAll: '#()'.
	((oldClass isNil or: [oldClass theNonMetaClass name asString ~= newClassName])
		and: [envt includesKey: newClassName asSymbol]) ifTrue:
			["Attempting to define new class over existing one when
				not looking at the original one in this browser..."
			(self confirm: ((newClassName , ' is an existing class in this system.
Redefining it might cause serious problems.
Is this really what you want to do?') asText makeBoldFrom: 1 to: newClassName size))
				ifFalse: [^ false]].
	"ar 8/29/1999: Use oldClass superclass for defining oldClass
	since oldClass superclass knows the definerClass of oldClass."
	oldClass ifNotNil:[oldClass _ oldClass superclass].
	class _ oldClass subclassDefinerClass
				evaluate: defString
				notifying: aController
				logged: true.
	(class isKindOf: Behavior)
		ifTrue: [self changed: #systemCategoryList.
				self changed: #classList.
				self clearUserEditFlag.
				self setClass: class selector: nil.
				"self clearUserEditFlag; editClass."
				^ true]
		ifFalse: [^ false]! !

!Browser methodsFor: 'class functions' stamp: 'nk 2/15/2004 13:23'!
editClass
	"Retrieve the description of the class definition."

	classListIndex = 0 ifTrue: [^ self].
	self okToChange ifFalse: [^ self].
	self messageCategoryListIndex: 0.
	self editSelection: #editClass.
	self changed: #contents.
	self changed: #classCommentText.
! !

!Browser methodsFor: 'class functions' stamp: 'sd 11/20/2005 21:26'!
editComment
	"Retrieve the description of the class comment."

	classListIndex = 0 ifTrue: [^ self].
	self okToChange ifFalse: [^ self].
	self messageCategoryListIndex: 0.
	metaClassIndicated := false.
	self editSelection: #editComment.
	self changed: #classSelectionChanged.
	self changed: #messageCategoryList.
	self changed: #messageList.
	
	
! !

!Browser methodsFor: 'class functions' stamp: 'sd 11/20/2005 21:26'!
explainSpecial: string 
	"Answer a string explaining the code pane selection if it is displaying 
	one of the special edit functions."

	| classes whole lits reply |
	(editSelection == #editClass or: [editSelection == #newClass])
		ifTrue: 
			["Selector parts in class definition"
			string last == $: ifFalse: [^nil].
			lits := Array with:
				#subclass:instanceVariableNames:classVariableNames:poolDictionaries:category:.
			(whole := lits detect: [:each | (each keywords
					detect: [:frag | frag = string] ifNone: []) ~~ nil]
						ifNone: []) ~~ nil
				ifTrue: [reply := '"' , string , ' is one part of the message selector ' , whole , '.']
				ifFalse: [^nil].
			classes := self systemNavigation allClassesImplementing: whole.
			classes := 'these classes ' , classes printString.
			^reply , '  It is defined in ' , classes , '."
Smalltalk browseAllImplementorsOf: #' , whole].

	editSelection == #hierarchy
		ifTrue: 
			["Instance variables in subclasses"
			classes := self selectedClassOrMetaClass allSubclasses.
			classes := classes detect: [:each | (each instVarNames
						detect: [:name | name = string] ifNone: []) ~~ nil]
					ifNone: [^nil].
			classes := classes printString.
			^'"is an instance variable in class ' , classes , '."
' , classes , ' browseAllAccessesTo: ''' , string , '''.'].
	editSelection == #editSystemCategories ifTrue: [^nil].
	editSelection == #editMessageCategories ifTrue: [^nil].
	^nil! !

!Browser methodsFor: 'class functions' stamp: 'tk 4/2/98 13:50'!
fileOutClass
	"Print a description of the selected class onto a file whose name is the 
	category name followed by .st."

Cursor write showWhile:
		[classListIndex ~= 0 ifTrue: [self selectedClass fileOut]]! !

!Browser methodsFor: 'class functions' stamp: 'rbb 3/1/2005 10:25'!
findMethod
	"Pop up a list of the current class's methods, and select the one chosen by the user"

	| aClass selectors reply cat messageCatIndex messageIndex |
	self classListIndex = 0 ifTrue: [^ self].
	self okToChange ifFalse: [^ self].
	aClass := self selectedClassOrMetaClass.
	selectors := aClass selectors asSortedArray.
	selectors isEmpty ifTrue: [self inform: aClass name, ' has no methods.'. ^ self].
	reply := (SelectionMenu
		labelList: (Array with: 'Enter Wildcard'), selectors
		lines: #(1)
		selections: (Array with: 'EnterWildcard'), selectors) startUp.
	reply == nil ifTrue: [^ self].
	reply = 'EnterWildcard'
		ifTrue: [
			reply := UIManager default request: 'Enter partial method name:'.
			(reply isNil or: [reply isEmpty])
				ifTrue: [^self].
			(reply includes: $*)
				ifFalse: [reply := '*', reply, '*'].
			selectors := selectors select: [:each | reply match: each].
			selectors isEmpty ifTrue: [self inform: aClass name, ' has no matching methods.'. ^ self].
			reply := selectors size = 1
				ifTrue: [selectors first]
				ifFalse: [
					(SelectionMenu
						labelList: selectors
						selections: selectors) startUp].
			reply == nil ifTrue: [^ self]].

	cat := aClass whichCategoryIncludesSelector: reply.
	messageCatIndex := self messageCategoryList indexOf: cat.
	self messageCategoryListIndex: messageCatIndex.
	messageIndex := (self messageList indexOf: reply).
	self messageListIndex: messageIndex! !

!Browser methodsFor: 'class functions' stamp: 'rbb 3/1/2005 10:26'!
findMethodWithWildcard
	"Pop up a list of the current class's methods, and select the one chosen by the user"

	| aClass selectors reply cat messageCatIndex messageIndex |
	self classListIndex = 0 ifTrue: [^ self].
	self okToChange ifFalse: [^ self].
	aClass := self selectedClassOrMetaClass.
	selectors := aClass selectors asSortedArray.
	selectors isEmpty ifTrue: [self inform: aClass name, ' has no methods.'. ^ self].

	reply := UIManager default request: 'Enter partial method name:'.
	(reply isNil or: [reply isEmpty])
		ifTrue: [^self].
	(reply includes: $*)
		ifFalse: [reply := '*', reply, '*'].
	selectors := selectors select: [:each | reply match: each].
	selectors isEmpty ifTrue: [self inform: aClass name, ' has no matching methods.'. ^ self].
	reply := selectors size = 1
		ifTrue: [selectors first]
		ifFalse: [
			(SelectionMenu
				labelList: selectors
				selections: selectors) startUp].
	reply == nil ifTrue: [^ self].

	cat := aClass whichCategoryIncludesSelector: reply.
	messageCatIndex := self messageCategoryList indexOf: cat.
	self messageCategoryListIndex: messageCatIndex.
	messageIndex := (self messageList indexOf: reply).
	self messageListIndex: messageIndex! !

!Browser methodsFor: 'class functions' stamp: 'nk 2/14/2004 15:09'!
hierarchy
	"Display the inheritance hierarchy of the receiver's selected class."

	classListIndex = 0 ifTrue: [^ self].
	self okToChange ifFalse: [^ self].
	self messageCategoryListIndex: 0.
	self editSelection: #hierarchy.
	self changed: #editComment.
	self contentsChanged.
	^ self! !

!Browser methodsFor: 'class functions' stamp: 'nk 2/14/2004 15:07'!
makeNewSubclass

	self selectedClassOrMetaClass ifNil: [^ self].
	self okToChange ifFalse: [^ self].
	self editSelection: #newClass.
	self contentsChanged! !

!Browser methodsFor: 'class functions' stamp: 'nk 2/14/2004 15:09'!
plusButtonHit
	"Cycle among definition, comment, and hierachy"

	editSelection == #editComment
		ifTrue: [self hierarchy. ^ self].
	editSelection == #hierarchy
		ifTrue: [self editSelection: #editClass.
			classListIndex = 0 ifTrue: [^ self].
			self okToChange ifFalse: [^ self].
			self changed: #editComment.
			self contentsChanged.
			^ self].
	self editComment! !

!Browser methodsFor: 'class functions' stamp: 'tk 4/2/98 13:50'!
printOutClass
	"Print a description of the selected class onto a file whose name is the 
	category name followed by .html."

Cursor write showWhile:
		[classListIndex ~= 0 ifTrue: [self selectedClass fileOutAsHtml: true]]! !

!Browser methodsFor: 'class functions' stamp: 'sw 3/5/2001 18:04'!
removeClass
	"If the user confirms the wish to delete the class, do so"

	super removeClass ifTrue:
		[self classListIndex: 0]! !

!Browser methodsFor: 'class functions' stamp: 'sd 11/20/2005 21:26'!
renameClass
	| oldName newName obs |
	classListIndex = 0
		ifTrue: [^ self].
	self okToChange
		ifFalse: [^ self].
	oldName := self selectedClass name.
	newName := self request: 'Please type new class name' initialAnswer: oldName.
	newName = ''
		ifTrue: [^ self].
	"Cancel returns ''"
	newName := newName asSymbol.
	newName = oldName
		ifTrue: [^ self].
	(Smalltalk includesKey: newName)
		ifTrue: [^ self error: newName , ' already exists'].
	self selectedClass rename: newName.
	self changed: #classList.
	self
		classListIndex: ((systemOrganizer listAtCategoryNamed: self selectedSystemCategoryName)
				indexOf: newName).
	obs := self systemNavigation
				allCallsOn: (Smalltalk associationAt: newName).
	obs isEmpty
		ifFalse: [self systemNavigation
				browseMessageList: obs
				name: 'Obsolete References to ' , oldName
				autoSelect: oldName]! !

!Browser methodsFor: 'class functions' stamp: 'md 7/29/2005 15:59'!
shiftedClassListMenu: aMenu
	"Set up the menu to apply to the receiver's class list when the shift key is down"

	^ aMenu addList: #(
			-
			('unsent methods'			browseUnusedMethods	'browse all methods defined by this class that have no senders')
			('unreferenced inst vars'	showUnreferencedInstVars	'show a list of all instance variables that are not referenced in methods')
			('unreferenced class vars'	showUnreferencedClassVars	'show a list of all class variables that are not referenced in methods')
			('subclass template'			makeNewSubclass		'put a template into the code pane for defining of a subclass of this class')
			-
			('sample instance'			makeSampleInstance		'give me a sample instance of this class, if possible')
			('inspect instances'			inspectInstances			'open an inspector on all the extant instances of this class')
			('inspect subinstances'		inspectSubInstances		'open an inspector on all the extant instances of this class and of all of its subclasses')
			-
			('add all meths to current chgs'		addAllMethodsToCurrentChangeSet
																'place all the methods defined by this class into the current change set')
			('create inst var accessors'	createInstVarAccessors	'compile instance-variable access methods for any instance variables that do not yet have them')
			-
			('more...'					offerUnshiftedClassListMenu	'return to the standard class-list menu'))! !


!Browser methodsFor: 'class list'!
classList
	"Answer an array of the class names of the selected category. Answer an 
	empty array if no selection exists."

	systemCategoryListIndex = 0
		ifTrue: [^Array new]
		ifFalse: [^systemOrganizer listAtCategoryNumber: systemCategoryListIndex]! !

!Browser methodsFor: 'class list'!
classListIndex
	"Answer the index of the current class selection."

	^classListIndex! !

!Browser methodsFor: 'class list' stamp: 'sd 11/20/2005 21:26'!
classListIndex: anInteger 
	"Set anInteger to be the index of the current class selection."

	| className |

	classListIndex := anInteger.
	self setClassOrganizer.
	messageCategoryListIndex := 0.
	messageListIndex := 0.
	self classCommentIndicated
		ifTrue: []
		ifFalse: [self editSelection: (anInteger = 0
					ifTrue: [metaClassIndicated | (systemCategoryListIndex == 0)
						ifTrue: [#none]
						ifFalse: [#newClass]]
					ifFalse: [#editClass])].
	contents := nil.
	self selectedClass isNil
		ifFalse: [className := self selectedClass name.
					(RecentClasses includes: className)
				ifTrue: [RecentClasses remove: className].
			RecentClasses addFirst: className.
			RecentClasses size > 16
				ifTrue: [RecentClasses removeLast]].
	self changed: #classSelectionChanged.
	self changed: #classCommentText.
	self changed: #classListIndex.	"update my selection"
	self changed: #messageCategoryList.
	self changed: #messageList.
	self changed: #relabel.
	self contentsChanged! !

!Browser methodsFor: 'class list' stamp: 'sd 11/20/2005 21:26'!
classListSingleton

	| name |
	name := self selectedClassName.
	^ name ifNil: [Array new]
		ifNotNil: [Array with: name]! !

!Browser methodsFor: 'class list' stamp: 'sd 11/20/2005 21:26'!
recent
	"Let the user select from a list of recently visited classes.  11/96 stp.
	 12/96 di:  use class name, not classes themselves.
	 : dont fall into debugger in empty case"

	| className class recentList |
	recentList := RecentClasses select: [:n | Smalltalk includesKey: n].
	recentList size == 0 ifTrue: [^ Beeper beep].
	className := (SelectionMenu selections: recentList) startUp.
	className == nil ifTrue: [^ self].
	class := Smalltalk at: className.
	self selectCategoryForClass: class.
	self classListIndex: (self classList indexOf: class name)! !

!Browser methodsFor: 'class list' stamp: 'sr 10/29/1999 20:28'!
selectClass: classNotMeta
	self classListIndex: (self classList indexOf: classNotMeta name)! !

!Browser methodsFor: 'class list' stamp: 'sd 11/20/2005 21:26'!
selectedClass
	"Answer the class that is currently selected. Answer nil if no selection 
	exists."

	| name envt |
	(name := self selectedClassName) ifNil: [^ nil].
	(envt := self selectedEnvironment) ifNil: [^ nil].
	^ envt at: name! !

!Browser methodsFor: 'class list' stamp: 'sd 11/20/2005 21:26'!
selectedClassName
	| aClassList |
	"Answer the name of the current class. Answer nil if no selection exists."

	(classListIndex = 0 or: [classListIndex > (aClassList := self classList) size]) ifTrue: [^ nil].
	^ aClassList at: classListIndex! !

!Browser methodsFor: 'class list'!
toggleClassListIndex: anInteger 
	"If anInteger is the current class index, deselect it. Else make it the 
	current class selection."

	self classListIndex: 
		(classListIndex = anInteger
			ifTrue: [0]
			ifFalse: [anInteger])! !


!Browser methodsFor: 'code pane' stamp: 'rr 8/19/2005 14:44'!
codePaneMenu: aMenu shifted: shifted 

	ServiceGui browser: self codePaneMenu: aMenu.
	Preferences useOnlyServicesInMenu ifTrue: [^aMenu].
	super codePaneMenu: aMenu shifted: shifted.
	^aMenu! !

!Browser methodsFor: 'code pane' stamp: 'sd 11/20/2005 21:26'!
compileMessage: aText notifying: aController
	"Compile the code that was accepted by the user, placing the compiled method into an appropriate message category.  Return true if the compilation succeeded, else false."

	| fallBackCategoryIndex fallBackMethodIndex originalSelectorName result |

	self selectedMessageCategoryName ifNil:
			[ self selectOriginalCategoryForCurrentMethod 	
										ifFalse:["Select the '--all--' category"
											self messageCategoryListIndex: 1]]. 


	self selectedMessageCategoryName asSymbol = ClassOrganizer allCategory
		ifTrue:
			[ "User tried to save a method while the ALL category was selected"
			fallBackCategoryIndex := messageCategoryListIndex.
			fallBackMethodIndex := messageListIndex.
			editSelection == #newMessage
				ifTrue:
					[ "Select the 'as yet unclassified' category"
					messageCategoryListIndex := 0.
					(result := self defineMessageFrom: aText notifying: aController)
						ifNil:
							["Compilation failure:  reselect the original category & method"
							messageCategoryListIndex := fallBackCategoryIndex.
							messageListIndex := fallBackMethodIndex]
						ifNotNil:
							[self setSelector: result]]
				ifFalse:
					[originalSelectorName := self selectedMessageName.
					self setOriginalCategoryIndexForCurrentMethod.
					messageListIndex := fallBackMethodIndex := self messageList indexOf: originalSelectorName.			
					(result := self defineMessageFrom: aText notifying: aController)
						ifNotNil:
							[self setSelector: result]
						ifNil:
							[ "Compilation failure:  reselect the original category & method"
							messageCategoryListIndex := fallBackCategoryIndex.
							messageListIndex := fallBackMethodIndex.
							^ result notNil]].
			self changed: #messageCategoryList.
			^ result notNil]
		ifFalse:
			[ "User tried to save a method while the ALL category was NOT selected"
			^ (self defineMessageFrom: aText notifying: aController) notNil]! !

!Browser methodsFor: 'code pane' stamp: 'sw 5/18/2001 20:55'!
showBytecodes
	"Show or hide the bytecodes of the selected method -- an older protocol now mostly not relevant."

	self toggleShowingByteCodes! !


!Browser methodsFor: 'construction' stamp: 'sd 11/20/2005 21:26'!
addLowerPanesTo: window at: nominalFractions with: editString
	| commentPane |
	super addLowerPanesTo: window at: nominalFractions with: editString.
	commentPane := self buildMorphicCommentPane.
	window addMorph: commentPane fullFrame: (LayoutFrame fractions: (0@0.75 corner: 1@1)).
	self changed: #editSelection.! !


!Browser methodsFor: 'copying' stamp: 'sd 11/20/2005 21:26'!
veryDeepInner: deepCopier
	"Copy all of my instance variables.  Some need to be not copied at all, but shared.  See DeepCopier class comment."

super veryDeepInner: deepCopier.
"systemOrganizer := systemOrganizer. 	clone has the old value. we share it"
"classOrganizer := classOrganizer		clone has the old value. we share it"
"metaClassOrganizer 	:= metaClassOrganizer	clone has the old value. we share it"
systemCategoryListIndex := systemCategoryListIndex veryDeepCopyWith: deepCopier.
classListIndex := classListIndex veryDeepCopyWith: deepCopier.
messageCategoryListIndex := messageCategoryListIndex veryDeepCopyWith: deepCopier.
messageListIndex := messageListIndex veryDeepCopyWith: deepCopier.
editSelection := editSelection veryDeepCopyWith: deepCopier.
metaClassIndicated := metaClassIndicated veryDeepCopyWith: deepCopier.
! !


!Browser methodsFor: 'drag and drop' stamp: 'nk 6/12/2004 17:43'!
acceptDroppingMorph: transferMorph event: evt inMorph: dstListMorph 
	"Here we are fetching informations from the dropped transferMorph 
	and  
	performing the correct action for this drop."
	| srcType success srcBrowser |
	success := false.
	srcType := transferMorph dragTransferType.
	srcBrowser := transferMorph source model.
	srcType == #messageList
		ifTrue: [ | srcClass srcSelector srcCategory |
			srcClass := transferMorph passenger key.
			srcSelector := transferMorph passenger value.
			srcCategory := srcBrowser selectedMessageCategoryName.
			srcCategory
				ifNil: [srcCategory := srcClass organization categoryOfElement: srcSelector].
			success := self
						acceptMethod: srcSelector
						messageCategory: srcCategory
						class: srcClass
						atListMorph: dstListMorph
						internal: self == srcBrowser
						copy: transferMorph shouldCopy].
	srcType == #classList
		ifTrue: [success := self
						changeCategoryForClass: transferMorph passenger
						srcSystemCategory: srcBrowser selectedSystemCategoryName
						atListMorph: dstListMorph
						internal: self == srcBrowser
						copy: transferMorph shouldCopy].
	^ success! !

!Browser methodsFor: 'drag and drop' stamp: 'sd 11/20/2005 21:26'!
acceptMethod: methodSel dstMessageCategory: dstMessageCategorySel srcMessageCategory: srcMessageCategorySel dstClass: dstClass dstClassOrMeta: dstClassOrMeta srcClassOrMeta: srcClassOrMeta internal: internal copySemantic: copyFlag 
	| success hierarchyChange higher checkForOverwrite |
	(success := dstClassOrMeta ~~ nil) ifFalse: [^false].
	checkForOverwrite := dstClassOrMeta selectors includes: methodSel.
	hierarchyChange := (higher := srcClassOrMeta inheritsFrom: dstClassOrMeta) | (dstClassOrMeta inheritsFrom: srcClassOrMeta).
	success := (checkForOverwrite not
				or: [self
						overwriteDialogHierarchyChange: hierarchyChange
						higher: higher
						sourceClassName: srcClassOrMeta name
						destinationClassName: dstClassOrMeta name
						methodSelector: methodSel])
				and: [self
						message: methodSel
						compileInClass: dstClassOrMeta
						fromClass: srcClassOrMeta
						dstMessageCategory: dstMessageCategorySel
						srcMessageCategory: srcMessageCategorySel
						internal: internal
						copySemantic: copyFlag].
	^ success! !

!Browser methodsFor: 'drag and drop' stamp: 'al 4/24/2004 11:50'!
acceptMethod: methodSel messageCategory: srcMessageCategorySel class: srcClassOrMeta atListMorph: dstListMorph internal: internal copy: copyFlag 
	| success dstClassOrMeta dstClass dstMessageCategorySel |
	dstClass _ self dstClassDstListMorph: dstListMorph.
	dstClassOrMeta _ dstClass
				ifNotNil: [self metaClassIndicated
						ifTrue: [dstClass classSide]
						ifFalse: [dstClass]].
	dstMessageCategorySel _ self dstMessageCategoryDstListMorph: dstListMorph.
	success _ (dstClassOrMeta notNil
				and: [dstClassOrMeta == srcClassOrMeta])
						ifTrue: ["one class"
							self
								changeMessageCategoryForMethod: methodSel
								dstMessageCategory: dstMessageCategorySel
								srcMessageCategory: srcMessageCategorySel
								insideClassOrMeta: dstClassOrMeta
								internal: internal
								copySemantic: copyFlag]
						ifFalse: ["different classes"
							self
								acceptMethod: methodSel
								dstMessageCategory: dstMessageCategorySel
								srcMessageCategory: srcMessageCategorySel
								dstClass: dstClass
								dstClassOrMeta: dstClassOrMeta
								srcClassOrMeta: srcClassOrMeta
								internal: internal
								copySemantic: copyFlag].
	^ success! !

!Browser methodsFor: 'drag and drop' stamp: 'sd 11/20/2005 21:26'!
changeCategoryForClass: class srcSystemCategory: srcSystemCategorySel atListMorph: dstListMorph internal: internal copy: copyFlag 
	"only move semantic"
	| newClassCategory success |
	self flag: #stringSymbolProblem.
	success := copyFlag not ifFalse: [^ false].
	newClassCategory := self dstCategoryDstListMorph: dstListMorph.
	(success := newClassCategory notNil & (newClassCategory ~= class category))
		ifTrue: 
			[class category: newClassCategory.
			self changed: #classList.
			internal ifFalse: [self selectClass: class]].
	^ success! !

!Browser methodsFor: 'drag and drop' stamp: 'nk 4/22/2004 18:00'!
changeMessageCategoryForMethod: methodSel dstMessageCategory: dstMessageCategorySel srcMessageCategory: srcMessageCategorySel insideClassOrMeta: classOrMeta internal: internal copySemantic: copyFlag 
	"Recategorize the method named by methodSel. 
	If the dstMessageCategorySel is the allCategory, then recategorize 
	it from its parents."
	| success messageCategorySel |
	copyFlag
		ifTrue: [^ false].
	"only move semantic"
	messageCategorySel := dstMessageCategorySel
				ifNil: [srcMessageCategorySel].
	(success := messageCategorySel notNil
					and: [messageCategorySel ~= srcMessageCategorySel])
		ifTrue: [success := messageCategorySel == ClassOrganizer allCategory
						ifTrue: [self recategorizeMethodSelector: methodSel]
						ifFalse: [(classOrMeta organization categories includes: messageCategorySel)
								and: [classOrMeta organization
										classify: methodSel
										under: messageCategorySel
										suppressIfDefault: false.
									true]]].
	success
		ifTrue: [self changed: #messageList.
			internal
				ifFalse: [self setSelector: methodSel]].
	^ success! !

!Browser methodsFor: 'drag and drop' stamp: 'sr 4/25/2000 07:12'!
codeTextMorph
	^ self dependents
		detect: [:dep | (dep isKindOf: PluggableTextMorph)
				and: [dep getTextSelector == #contents]]
		ifNone: []! !

!Browser methodsFor: 'drag and drop' stamp: 'mir 5/16/2000 11:35'!
dragAnimationFor: item transferMorph: transferMorph 
	TransferMorphLineAnimation on: transferMorph! !

!Browser methodsFor: 'drag and drop' stamp: 'sd 11/20/2005 21:26'!
dragPassengerFor: item inMorph: dragSource 
	| transferType smn |
	(dragSource isKindOf: PluggableListMorph)
		ifFalse: [^nil].
	transferType := self dragTransferTypeForMorph: dragSource.
	transferType == #classList
		ifTrue: [^self selectedClass].
	transferType == #messageList
		ifFalse: [ ^nil ].
	smn := self selectedMessageName ifNil: [ ^nil ].
	(MessageSet isPseudoSelector: smn) ifTrue: [ ^nil ].

	^ self selectedClassOrMetaClass -> smn.
! !

!Browser methodsFor: 'drag and drop' stamp: 'panda 4/28/2000 16:18'!
dragTransferTypeForMorph: dragSource 
	^(dragSource isKindOf: PluggableListMorph)
		ifTrue: [dragSource getListSelector]! !

!Browser methodsFor: 'drag and drop' stamp: 'ls 6/22/2001 23:21'!
dstCategoryDstListMorph: dstListMorph
	^(dstListMorph getListSelector == #systemCategoryList)
		ifTrue: [dstListMorph potentialDropItem ]
		ifFalse: [self selectedSystemCategoryName]! !

!Browser methodsFor: 'drag and drop' stamp: 'sd 11/20/2005 21:26'!
dstClassDstListMorph: dstListMorph
	| dropItem |
	^(dstListMorph getListSelector == #classList)
		ifTrue: [(dropItem := dstListMorph potentialDropItem) ifNotNil: [Smalltalk at: dropItem withBlanksCondensed asSymbol]]
		ifFalse: [dstListMorph model selectedClass]! !

!Browser methodsFor: 'drag and drop' stamp: 'sd 11/20/2005 21:26'!
dstMessageCategoryDstListMorph: dstListMorph
	| dropItem |
	^dstListMorph getListSelector == #messageCategoryList
		ifTrue: 
			[dropItem := dstListMorph potentialDropItem.
			dropItem ifNotNil: [dropItem asSymbol]]
		ifFalse: [self selectedMessageCategoryName ifNil: [ Categorizer default ]]! !

!Browser methodsFor: 'drag and drop' stamp: 'sd 11/20/2005 21:26'!
message: messageSel compileInClass: dstClassOrMeta fromClass: srcClassOrMeta dstMessageCategory: dstMessageCategorySel srcMessageCategory: srcMessageCategorySel internal: internal copySemantic: copyFlag 
	| source messageCategorySel tm success oldOrNoMethod newMethod |
	source := srcClassOrMeta sourceCodeAt: messageSel.
	messageCategorySel := dstMessageCategorySel ifNil: [srcMessageCategorySel].
	self selectClass: dstClassOrMeta theNonMetaClass.
	(self messageCategoryList includes: messageCategorySel)
		ifFalse: ["create message category"
			self classOrMetaClassOrganizer addCategory: messageCategorySel].
	self selectMessageCategoryNamed: messageCategorySel.
	tm := self codeTextMorph.
	tm setText: source.
	tm setSelection: (0 to: 0).
	tm hasUnacceptedEdits: true.
	oldOrNoMethod := srcClassOrMeta compiledMethodAt: messageSel ifAbsent: [].
	tm accept.
	"compilation successful?"
	newMethod := dstClassOrMeta compiledMethodAt: messageSel ifAbsent: [].
	success := newMethod ~~ nil & (newMethod ~~ oldOrNoMethod).
	"	success ifFalse: [TransferMorph allInstances do: [:e | e delete]].            
	 "
	success
		ifTrue: 
			[copyFlag not ifTrue: ["remove old method in move semantic if new exists"
		srcClassOrMeta removeSelector: messageSel].internal
				ifTrue: [self selectClass: srcClassOrMeta]
				ifFalse: [self selectClass: dstClassOrMeta].
			self setSelector: messageSel].
	^ success! !

!Browser methodsFor: 'drag and drop' stamp: 'sd 11/20/2005 21:26'!
overwriteDialogHierarchyChange: hierarchyChange higher: higherFlag sourceClassName: srcClassName destinationClassName: dstClassName methodSelector: methodSelector 
	| lf success |
	lf := Character cr asString.
	success := SelectionMenu
				confirm: 'There is a conflict.' , ' Overwrite' , (hierarchyChange
							ifTrue: [higherFlag
									ifTrue: [' superclass']
									ifFalse: [' subclass']]
							ifFalse: ['']) , ' method' , lf , dstClassName , '>>' , methodSelector , lf , 'by ' , (hierarchyChange
							ifTrue: ['moving']
							ifFalse: ['copying']) , ' method' , lf , srcClassName name , '>>' , methodSelector , ' ?'
				trueChoice: 'Yes, don''t care.'
				falseChoice: 'No, I have changed my opinion.'.
	^ success! !

!Browser methodsFor: 'drag and drop' stamp: 'sd 11/20/2005 21:26'!
wantsDroppedMorph: transferMorph event: anEvent inMorph: destinationLM 
	"We are only interested in TransferMorphs as wrappers for             
	informations. If their content is really interesting for us, will             
	determined later in >>acceptDroppingMorph:event:."

	| srcType dstType |

	"only want drops on lists (not, for example, on pluggable texts)"
	(destinationLM isKindOf: PluggableListMorph) ifFalse: [^ false].

	srcType := transferMorph dragTransferType.
	dstType := destinationLM getListSelector.

	(srcType == #messageList
		and: [dstType == #messageCategoryList or: [dstType == #classList]])
		ifTrue: [^true].
	(srcType == #classList
		and: [dstType == #systemCategoryList])
		ifTrue: [^true].
"			[
			srcLS == #messageList ifTrue: [^ dstLS == #messageList | (dstLS == #messageCategoryList) | (dstLS == #classList)].
			srcLS == #classList ifTrue: [^ dstLS == #classList | (dstLS == #systemCategoryList)]].
"
	^ false! !


!Browser methodsFor: 'initialize-release' stamp: 'md 2/24/2006 15:24'!
addAListPane: aListPane to: window at: nominalFractions plus: verticalOffset

	| row switchHeight divider |

	row := AlignmentMorph newColumn
		hResizing: #spaceFill;
		vResizing: #spaceFill;
		layoutInset: 1;
		borderWidth: 1;
		layoutPolicy: ProportionalLayout new.
	switchHeight := 25.
	self 
		addMorphicSwitchesTo: row 
		at: (
			LayoutFrame 
				fractions: (0@1 corner: 1@1) 
				offsets: (0@(1-switchHeight)  corner: 0@0)
		).

	divider := BorderedSubpaneDividerMorph forTopEdge.
	divider extent: 4@4; color: Color transparent; borderColor: #raised; borderWidth: 0.
	row 
		addMorph: divider
		fullFrame: (
			LayoutFrame 
				fractions: (0@1 corner: 1@1) 
				offsets: (0@switchHeight negated corner: 0@(1-switchHeight))
		).	

	row 
		addMorph: aListPane
		fullFrame: (
			LayoutFrame 
				fractions: (0@0 corner: 1@1) 
				offsets: (0@0 corner: 0@(switchHeight negated))
		).	

	window 
		addMorph: row
		fullFrame: (
			LayoutFrame 
				fractions: nominalFractions 
				offsets: (0@verticalOffset corner: 0@0)
		).	
	row on: #mouseEnter send: #paneTransition: to: window.
	row on: #mouseLeave send: #paneTransition: to: window.

! !

!Browser methodsFor: 'initialize-release' stamp: 'RAA 1/10/2001 11:46'!
addClassAndSwitchesTo: window at: nominalFractions plus: verticalOffset

	^self
		addAListPane: self buildMorphicClassList 
		to: window 
		at: nominalFractions 
		plus: verticalOffset
! !

!Browser methodsFor: 'initialize-release' stamp: 'rr 6/21/2005 13:24'!
addMorphicSwitchesTo: window at: aLayoutFrame

	window 
		addMorph: self buildMorphicSwitches
		fullFrame: aLayoutFrame.

! !

!Browser methodsFor: 'initialize-release' stamp: 'rww 8/18/2002 09:31'!
browseSelectionInPlace

	"In place code - incomplete"
"	self systemCategoryListIndex: 
		(self systemCategoryList indexOf: self selectedClass category).
	self classListIndex: (self classList indexOf: self selectedClass name)"

	self spawnHierarchy.! !

!Browser methodsFor: 'initialize-release'!
browserWindowActivated
	"Called when a window whose model is the receiver is reactivated, giving the receiver an opportunity to take steps if it wishes.  The default is to do nothing.  8/5/96 sw"! !

!Browser methodsFor: 'initialize-release' stamp: 'sd 11/20/2005 21:26'!
buildClassSwitchView

	| aSwitchView |
	aSwitchView := PluggableButtonView
		on: self
		getState: #classMessagesIndicated
		action: #indicateClassMessages.
	aSwitchView
		label: 'class';
		window: (0@0 extent: 15@8);
		askBeforeChanging: true.
	^ aSwitchView
! !

!Browser methodsFor: 'initialize-release' stamp: 'sd 11/20/2005 21:26'!
buildCommentSwitchView

	| aSwitchView |
	aSwitchView := PluggableButtonView
		on: self
		getState: #classCommentIndicated
		action: #plusButtonHit.
	aSwitchView
		label: '?' asText allBold;
		borderWidthLeft: 0 right: 1 top: 0 bottom: 0;	
		window: (0@0 extent: 10@8);
		askBeforeChanging: true.
	^ aSwitchView
! !

!Browser methodsFor: 'initialize-release' stamp: 'sd 11/20/2005 21:26'!
buildInstanceClassSwitchView
	| aView aSwitchView instSwitchView comSwitchView |

	aView := View new model: self.
	aView window: (0 @ 0 extent: 50 @ 8).
	instSwitchView := self buildInstanceSwitchView.
	aView addSubView: instSwitchView.
	comSwitchView := self buildCommentSwitchView.
	aView addSubView: comSwitchView toRightOf: instSwitchView.
	aSwitchView := self buildClassSwitchView.
	aView addSubView: aSwitchView toRightOf: comSwitchView.
	^aView! !

!Browser methodsFor: 'initialize-release' stamp: 'sd 11/20/2005 21:26'!
buildInstanceSwitchView

	| aSwitchView |
	aSwitchView := PluggableButtonView
		on: self
		getState: #instanceMessagesIndicated
		action: #indicateInstanceMessages.
	aSwitchView
		label: 'instance';
		borderWidthLeft: 0 right: 1 top: 0 bottom: 0;	
		window: (0@0 extent: 25@8);
		askBeforeChanging: true.
	^ aSwitchView
! !

!Browser methodsFor: 'initialize-release' stamp: 'wiz 7/19/2005 23:38'!
buildMorphicClassList

	| myClassList |

	(myClassList := PluggableListMorph new) 
			setProperty: #highlightSelector toValue: #highlightClassList:with:;

			on: self list: #classList
			selected: #classListIndex changeSelected: #classListIndex:
			menu: #classListMenu:shifted: keystroke: #classListKey:from:.
	myClassList borderWidth: 0.
	myClassList enableDragNDrop: Preferences browseWithDragNDrop.
	myClassList doubleClickSelector: #browseSelectionInPlace.
	"For doubleClick to work best disable autoDeselect"
	myClassList autoDeselect: false .
	^myClassList

! !

!Browser methodsFor: 'initialize-release' stamp: 'sd 11/20/2005 21:26'!
buildMorphicMessageCatList

	| myMessageCatList |

	(myMessageCatList := PluggableMessageCategoryListMorph new) 
			setProperty: #highlightSelector toValue: #highlightMessageCategoryList:with:;

			on: self list: #messageCategoryList
			selected: #messageCategoryListIndex changeSelected: #messageCategoryListIndex:
			menu: #messageCategoryMenu: 
			keystroke: #arrowKey:from: getRawListSelector: #rawMessageCategoryList.
	myMessageCatList enableDragNDrop: Preferences browseWithDragNDrop.
	^myMessageCatList
! !

!Browser methodsFor: 'initialize-release' stamp: 'sd 11/20/2005 21:26'!
buildMorphicMessageList
	"Build a morphic message list, with #messageList as its list-getter"

	| aListMorph |
	(aListMorph := PluggableListMorph new) 
			setProperty: #highlightSelector toValue: #highlightMessageList:with:;
			setProperty: #balloonTextSelectorForSubMorphs toValue: #balloonTextForMethodString;
			on: self list: #messageList
			selected: #messageListIndex changeSelected: #messageListIndex:
			menu: #messageListMenu:shifted:
			keystroke: #messageListKey:from:.
	aListMorph enableDragNDrop: Preferences browseWithDragNDrop.
	aListMorph menuTitleSelector: #messageListSelectorTitle.
	^aListMorph

! !

!Browser methodsFor: 'initialize-release' stamp: 'md 2/24/2006 15:25'!
buildMorphicSwitches

	| instanceSwitch commentSwitch classSwitch row aColor |

	instanceSwitch := PluggableButtonMorph
		on: self
		getState: #instanceMessagesIndicated
		action: #indicateInstanceMessages.
	instanceSwitch
		label: 'instance';
		askBeforeChanging: true;
		borderWidth: 1;
		borderColor: Color gray.
	commentSwitch := PluggableButtonMorph
		on: self
		getState: #classCommentIndicated
		action: #plusButtonHit.
		
	commentSwitch
		label: '?' asText allBold;
		askBeforeChanging: true;
		setBalloonText: 'class comment';
		borderWidth: 1;
		borderColor: Color gray.
	classSwitch := PluggableButtonMorph
		on: self
		getState: #classMessagesIndicated
		action: #indicateClassMessages.
	classSwitch
		label: 'class';
		askBeforeChanging: true;
		borderWidth: 1;
		borderColor: Color gray.
	row := AlignmentMorph newRow
		hResizing: #spaceFill;
		vResizing: #spaceFill;
		cellInset: 1;
		borderWidth: 0;
		addMorphBack: instanceSwitch;
		addMorphBack: commentSwitch;
		addMorphBack: classSwitch.

	aColor := Color white.
	row color: aColor muchLighter.
	{instanceSwitch. commentSwitch. classSwitch} do: [:m | 
		m 
			color: aColor;
			onColor: aColor darker darker offColor: aColor;
			hResizing: #spaceFill;
			vResizing: #spaceFill.].
	^ row
! !

!Browser methodsFor: 'initialize-release' stamp: 'sd 11/20/2005 21:26'!
buildMorphicSystemCatList
	| dragNDropFlag myCatList |
	dragNDropFlag := Preferences browseWithDragNDrop.
	(myCatList := PluggableListMorph new) 
			setProperty: #highlightSelector toValue: #highlightSystemCategoryList:with:;

			on: self list: #systemCategoryList
			selected: #systemCategoryListIndex changeSelected: #systemCategoryListIndex:
			menu: #systemCategoryMenu: keystroke: #systemCatListKey:from:.
	myCatList enableDragNDrop: dragNDropFlag.
	^myCatList
! !

!Browser methodsFor: 'initialize-release' stamp: 'sd 11/20/2005 21:26'!
buildOptionalButtonsView
	"Build the view for the optional buttons (mvc)"

	| aView buttonView offset bWidth bHeight first previousView |
	aView := View new model: self.
	bHeight := self optionalButtonHeight.
	aView window: (0 @ 0 extent: 200 @ bHeight).
	offset := 0.
	first := true.
	previousView := nil.
	self optionalButtonPairs do: [:pair |
		buttonView := PluggableButtonView on: self
			getState: nil
			action: pair second.
		buttonView
			label: pair first asParagraph.
		bWidth := buttonView label boundingBox width // 2.  "Need something more deterministic."
		buttonView window: (offset@0 extent: bWidth@bHeight).
		offset := offset + bWidth + 0.
		first
			ifTrue:
				[aView addSubView: buttonView.
				first := false]
			ifFalse:
				[buttonView borderWidthLeft: 1 right: 0 top: 0 bottom: 0.
				aView addSubView: buttonView toRightOf: previousView]. 
		previousView := buttonView].
	^ aView! !

!Browser methodsFor: 'initialize-release' stamp: 'sw 1/13/2000 16:45'!
defaultBrowserTitle
	^ 'System Browser'! !

!Browser methodsFor: 'initialize-release' stamp: 'ar 1/31/2001 20:56'!
highlightClassList: list with: morphList! !

!Browser methodsFor: 'initialize-release' stamp: 'ar 1/31/2001 20:56'!
highlightMessageCategoryList: list with: morphList! !

!Browser methodsFor: 'initialize-release' stamp: 'ar 1/31/2001 20:56'!
highlightSystemCategoryList: list with: morphList! !

!Browser methodsFor: 'initialize-release' stamp: 'nk 2/13/2001 13:25'!
labelString
	^self selectedClass ifNil: [ self defaultBrowserTitle ]
		ifNotNil: [ self defaultBrowserTitle, ': ', self selectedClass printString ].
! !

!Browser methodsFor: 'initialize-release' stamp: 'sw 9/22/1999 17:13'!
methodCategoryChanged
	self changed: #messageCategoryList.
	self changed: #messageList.
	self changed: #annotation.
	self messageListIndex: 0! !

!Browser methodsFor: 'initialize-release' stamp: 'sd 11/20/2005 21:26'!
openAsMorphClassEditing: editString
	"Create a pluggable version a Browser on just a single class."
	| window dragNDropFlag hSepFrac switchHeight mySingletonClassList |

	window := (SystemWindow labelled: 'later') model: self.
	dragNDropFlag := Preferences browseWithDragNDrop.
	hSepFrac := 0.3.
	switchHeight := 25.
	mySingletonClassList := PluggableListMorph on: self list: #classListSingleton
			selected: #indexIsOne changeSelected: #indexIsOne:
			menu: #classListMenu:shifted: keystroke: #classListKey:from:.
	mySingletonClassList enableDragNDrop: dragNDropFlag.

	self 
		addLowerPanesTo: window 
		at: (0@hSepFrac corner: 1@1) 
		with: editString.
	window 
		addMorph: mySingletonClassList
		fullFrame: (
			LayoutFrame 
				fractions: (0@0 corner: 0.5@0) 
				offsets: (0@0 corner: 0@switchHeight)
		).
	
	self 
		addMorphicSwitchesTo: window 
		at: (
			LayoutFrame 
				fractions: (0.5@0 corner: 1.0@0) 
				offsets: (0@0 corner: 0@switchHeight)
		).

	window 
		addMorph: self buildMorphicMessageCatList
		fullFrame: (
			LayoutFrame 
				fractions: (0@0 corner: 0.5@hSepFrac) 
				offsets: (0@switchHeight corner: 0@0)
		).

	window 
		addMorph: self buildMorphicMessageList
		fullFrame: (
			LayoutFrame 
				fractions: (0.5@0 corner: 1.0@hSepFrac) 
				offsets: (0@switchHeight corner: 0@0)
		).

	window setUpdatablePanesFrom: #(messageCategoryList messageList).
	^ window
! !

!Browser methodsFor: 'initialize-release' stamp: 'sd 11/20/2005 21:26'!
openAsMorphEditing: editString
	"Create a pluggable version of all the morphs for a Browser in Morphic"
	| window hSepFrac |

	hSepFrac := 0.4.
	window := (SystemWindow labelled: 'later') model: self.

"The method SystemWindow>>addMorph:fullFrame: checks scrollBarsOnRight, then adds the morph at the back if true, otherwise it is added in front. But flopout hScrollbars need the lowerpanes to be behind the upper ones in the draw order. Hence the value of scrollBarsOnRight affects the order in which the lowerpanes are added. "
	Preferences scrollBarsOnRight ifFalse:
		[self 
			addLowerPanesTo: window 
			at: (0@hSepFrac corner: 1@1) 
			with: editString].
		
	window 
		addMorph: self buildMorphicSystemCatList
		frame: (0@0 corner: 0.25@hSepFrac).
	self 
		addClassAndSwitchesTo: window 
		at: (0.25@0 corner: 0.5@hSepFrac)
		plus: 0.
	window 
		addMorph: self buildMorphicMessageCatList
		frame: (0.5@0 extent: 0.25@hSepFrac).
	window addMorph: self buildMorphicMessageList
		frame: (0.75@0 extent: 0.25@hSepFrac).

	Preferences scrollBarsOnRight ifTrue:
		[self 
			addLowerPanesTo: window 
			at: (0@hSepFrac corner: 1@1) 
			with: editString].

	window setUpdatablePanesFrom: #(systemCategoryList classList messageCategoryList messageList).
	^ window
! !

!Browser methodsFor: 'initialize-release' stamp: 'sd 11/20/2005 21:26'!
openAsMorphMessageEditing: editString
	"Create a pluggable version a Browser that shows just one message"
	| window mySingletonMessageList verticalOffset nominalFractions |
	window := (SystemWindow labelled: 'later') model: self.

	mySingletonMessageList := PluggableListMorph on: self list: #messageListSingleton
			selected: #indexIsOne changeSelected: #indexIsOne:
			menu: #messageListMenu:shifted:
			keystroke: #messageListKey:from:.
	mySingletonMessageList enableDragNDrop: Preferences browseWithDragNDrop.
	verticalOffset := 25.
	nominalFractions := 0@0 corner: 1@0.
	window 
		addMorph: mySingletonMessageList
		fullFrame: (
			LayoutFrame 
				fractions: nominalFractions 
				offsets: (0@0 corner: 0@verticalOffset)
		).

	verticalOffset := self addOptionalAnnotationsTo: window at: nominalFractions plus: verticalOffset.
	verticalOffset := self addOptionalButtonsTo: window  at: nominalFractions plus: verticalOffset.

	window 
		addMorph: (self buildMorphicCodePaneWith: editString)
		fullFrame: (
			LayoutFrame 
				fractions: (0@0 corner: 1@1) 
				offsets: (0@verticalOffset corner: 0@0)
		).

	^ window! !

!Browser methodsFor: 'initialize-release' stamp: 'sd 11/20/2005 21:26'!
openAsMorphMsgCatEditing: editString
	"Create a pluggable version a Browser on just a message category."

	| window hSepFrac |
	window := (SystemWindow labelled: 'later') model: self.
	hSepFrac := 0.3.
	window 
		addMorph: ((PluggableListMorph on: self list: #messageCatListSingleton
			selected: #indexIsOne changeSelected: #indexIsOne:
			menu: #messageCategoryMenu:) enableDragNDrop: Preferences browseWithDragNDrop)
		fullFrame: (
			LayoutFrame 
				fractions: (0@0 corner: 1@0) 
				offsets: (0@0 corner: 0@25)
		).
	window 
		addMorph: self buildMorphicMessageList
		fullFrame: (
			LayoutFrame 
				fractions: (0@0 corner: 1@hSepFrac) 
				offsets: (0@25 corner: 0@0)
		).

	self 
		addLowerPanesTo: window 
		at: (0@hSepFrac corner: 1@1) 
		with: editString.
	window setUpdatablePanesFrom: #(messageCatListSingleton messageList).
	^ window! !

!Browser methodsFor: 'initialize-release' stamp: 'sd 11/20/2005 21:26'!
openAsMorphSysCatEditing: editString
	"Create a pluggable version of all the views for a Browser, including views and controllers."
	| window hSepFrac switchHeight mySingletonList nextOffsets |

	window := (SystemWindow labelled: 'later') model: self.
	hSepFrac := 0.30.
	switchHeight := 25.
	mySingletonList := PluggableListMorph on: self list: #systemCategorySingleton
			selected: #indexIsOne changeSelected: #indexIsOne:
			menu: #systemCatSingletonMenu: keystroke: #systemCatSingletonKey:from:.
 	mySingletonList enableDragNDrop: Preferences browseWithDragNDrop.
	mySingletonList hideScrollBarsIndefinitely.
	window 
		addMorph: mySingletonList
		fullFrame: (
			LayoutFrame 
				fractions: (0@0 corner: 1@0) 
				offsets: (0@0  corner: 0@switchHeight)
		).	

	self 
		addClassAndSwitchesTo: window 
		at: (0@0 corner: 0.3333@hSepFrac)
		plus: switchHeight.

	nextOffsets := 0@switchHeight corner: 0@0.
	window 
		addMorph: self buildMorphicMessageCatList
		fullFrame: (
			LayoutFrame 
				fractions: (0.3333@0 corner: 0.6666@hSepFrac) 
				offsets: nextOffsets
		).	

	window 
		addMorph: self buildMorphicMessageList
		fullFrame: (
			LayoutFrame 
				fractions: (0.6666@0 corner: 1@hSepFrac) 
				offsets: nextOffsets
		).	

	self 
		addLowerPanesTo: window 
		at: (0@hSepFrac corner: 1@1) 
		with: editString.

	window setUpdatablePanesFrom: #( classList messageCategoryList messageList).
	^ window! !

!Browser methodsFor: 'initialize-release' stamp: 'sd 11/20/2005 21:26'!
openEditString: aString
        "Create a pluggable version of all the views for a Browser, including views and controllers."
        | systemCategoryListView classListView 
        messageCategoryListView messageListView browserCodeView topView switchView underPane y optionalButtonsView annotationPane |

        self couldOpenInMorphic ifTrue: [^ self openAsMorphEditing: aString].
        "Sensor leftShiftDown ifTrue: [^ self openAsMorphEditing: aString].
                uncomment-out for testing morphic browser embedded in mvc project"

        topView := StandardSystemView new model: self.
        topView borderWidth: 1. "label and minSize taken care of by caller"

        systemCategoryListView := PluggableListView on: self
                list: #systemCategoryList
                selected: #systemCategoryListIndex
                changeSelected: #systemCategoryListIndex:
                menu: #systemCategoryMenu:
                keystroke: #systemCatListKey:from:.
        systemCategoryListView window: (0 @ 0 extent: 50 @ 70).
        topView addSubView: systemCategoryListView.

        classListView := PluggableListView on: self
                list: #classList
                selected: #classListIndex
                changeSelected: #classListIndex:
                menu: #classListMenu:shifted:
                keystroke: #classListKey:from:.
        classListView window: (0 @ 0 extent: 50 @ 62).
        topView addSubView: classListView toRightOf: systemCategoryListView.

        switchView := self buildInstanceClassSwitchView.
        switchView borderWidth: 1.
        topView addSubView: switchView below: classListView.

        messageCategoryListView := PluggableListView on: self
                list: #messageCategoryList
                selected: #messageCategoryListIndex
                changeSelected: #messageCategoryListIndex:
                menu: #messageCategoryMenu:. 
        messageCategoryListView controller terminateDuringSelect: true.
        messageCategoryListView window: (0 @ 0 extent: 50 @ 70).
        topView addSubView: messageCategoryListView toRightOf: classListView.

        messageListView := PluggableListView on: self
                list: #messageList
                selected: #messageListIndex
                changeSelected: #messageListIndex:
                menu: #messageListMenu:shifted:
                keystroke: #messageListKey:from:.
        messageListView window: (0 @ 0 extent: 50 @ 70).
        messageListView menuTitleSelector: #messageListSelectorTitle.
        topView addSubView: messageListView toRightOf: messageCategoryListView.

       self wantsAnnotationPane
                ifTrue:
                        [annotationPane := PluggableTextView on: self
                                text: #annotation accept: nil
                                readSelection: nil menu: nil.
                        annotationPane window: (0@0 extent: 200@self optionalAnnotationHeight).
                        topView addSubView: annotationPane below: systemCategoryListView.
                        underPane := annotationPane.
                        y := 110 - self optionalAnnotationHeight]
                ifFalse: [
                        underPane := systemCategoryListView.
                        y := 110].

        self wantsOptionalButtons ifTrue:
                [optionalButtonsView := self buildOptionalButtonsView.
                optionalButtonsView borderWidth: 1.
                topView addSubView: optionalButtonsView below: underPane.
                underPane := optionalButtonsView.
                y := y - self optionalButtonHeight].

        browserCodeView := MvcTextEditor default on: self 
                        text: #contents accept: #contents:notifying:
                        readSelection: #contentsSelection menu: #codePaneMenu:shifted:.
        browserCodeView window: (0@0 extent: 200@y).
        topView addSubView: browserCodeView below: underPane.
        aString ifNotNil: [browserCodeView editString: aString.
                        browserCodeView hasUnacceptedEdits: true].
        topView setUpdatablePanesFrom: #(systemCategoryList classList messageCategoryList messageList).

        ^ topView! !

!Browser methodsFor: 'initialize-release' stamp: 'sd 11/20/2005 21:26'!
openMessageCatEditString: aString
        "Create a pluggable version of the views for a Browser that just shows one message category."
        | messageCategoryListView messageListView browserCodeView topView annotationPane underPane y optionalButtonsView |

        self couldOpenInMorphic ifTrue: [^ self openAsMorphMsgCatEditing: aString].

        topView := (StandardSystemView new) model: self.
        topView borderWidth: 1.
                "label and minSize taken care of by caller"

        messageCategoryListView := PluggableListView on: self
                list: #messageCatListSingleton
                selected: #indexIsOne 
                changeSelected: #indexIsOne:
                menu: #messageCategoryMenu:.
        messageCategoryListView window: (0 @ 0 extent: 200 @ 12).
        topView addSubView: messageCategoryListView.

        messageListView := PluggableListView on: self
                list: #messageList
                selected: #messageListIndex
                changeSelected: #messageListIndex:
                menu: #messageListMenu:shifted:
                keystroke: #messageListKey:from:.
        messageListView menuTitleSelector: #messageListSelectorTitle.
        messageListView window: (0 @ 0 extent: 200 @ 70).
        topView addSubView: messageListView below: messageCategoryListView.

        self wantsAnnotationPane
                ifTrue:
                        [annotationPane := PluggableTextView on: self
                                text: #annotation accept: nil
                                readSelection: nil menu: nil.
                        annotationPane window: (0@0 extent: 200@self optionalAnnotationHeight).
                        topView addSubView: annotationPane below: messageListView.
                        underPane := annotationPane.
                        y := (200 - 12 - 70) - self optionalAnnotationHeight]
                ifFalse:
                        [underPane := messageListView.
                        y := (200 - 12 - 70)].

        self wantsOptionalButtons ifTrue:
                [optionalButtonsView := self buildOptionalButtonsView.
                optionalButtonsView borderWidth: 1.
                topView addSubView: optionalButtonsView below: underPane.
                underPane := optionalButtonsView.
                y := y - self optionalButtonHeight].

        browserCodeView := MvcTextEditor default on: self 
                        text: #contents accept: #contents:notifying:
                        readSelection: #contentsSelection menu: #codePaneMenu:shifted:.
        browserCodeView window: (0@0 extent: 200@y).
        topView addSubView: browserCodeView below: underPane.
        aString ifNotNil: [browserCodeView editString: aString.
                        browserCodeView hasUnacceptedEdits: true].
        topView setUpdatablePanesFrom: #(messageCatListSingleton messageList).
        ^ topView! !

!Browser methodsFor: 'initialize-release' stamp: 'sd 11/20/2005 21:26'!
openMessageEditString: aString
	"Create a pluggable version of the views for a Browser that just shows one message."
	| messageListView browserCodeView topView annotationPane underPane y |

	Smalltalk isMorphic ifTrue: [^ self openAsMorphMessageEditing: aString].

	topView := (StandardSystemView new) model: self.
	topView borderWidth: 1.
		"label and minSize taken care of by caller"

	messageListView := PluggableListView on: self
		list: #messageListSingleton
		selected: #indexIsOne 
		changeSelected: #indexIsOne:
		menu: #messageListMenu:shifted:.
	messageListView window: (0 @ 0 extent: 200 @ 12).
	topView addSubView: messageListView.

	 self wantsAnnotationPane
		ifTrue:
			[annotationPane := PluggableTextView on: self
				text: #annotation accept: nil
				readSelection: nil menu: nil.
			annotationPane window: (0@0 extent: 200@self optionalAnnotationHeight).
			topView addSubView: annotationPane below: messageListView.
			underPane := annotationPane.
			y := (200 - 12) - self optionalAnnotationHeight]
		ifFalse:
			[underPane := messageListView.
			y := 200 - 12].

	browserCodeView := MvcTextEditor default on: self 
			text: #contents accept: #contents:notifying:
			readSelection: #contentsSelection menu: #codePaneMenu:shifted:.
	browserCodeView window: (0@0 extent: 200@y).
	topView addSubView: browserCodeView below: underPane.
	aString ifNotNil: [browserCodeView editString: aString.
			browserCodeView hasUnacceptedEdits: true].
	^ topView! !

!Browser methodsFor: 'initialize-release' stamp: 'sd 11/20/2005 21:26'!
openOnClassWithEditString: aString
	"Create a pluggable version of all the views for a Browser, including views and controllers."
	| classListView messageCategoryListView messageListView browserCodeView topView switchView annotationPane underPane y optionalButtonsView |

	Smalltalk isMorphic ifTrue: [^ self openAsMorphClassEditing: aString].

	topView := (StandardSystemView new) model: self.
	topView borderWidth: 1.
		"label and minSize taken care of by caller"

	classListView := PluggableListView on: self
		list: #classListSingleton
		selected: #indexIsOne 
		changeSelected: #indexIsOne:
		menu: #classListMenu:shifted:
		keystroke: #classListKey:from:.
	classListView window: (0 @ 0 extent: 100 @ 12).
	topView addSubView: classListView.

	messageCategoryListView := PluggableListView on: self
		list: #messageCategoryList
		selected: #messageCategoryListIndex
		changeSelected: #messageCategoryListIndex:
		menu: #messageCategoryMenu:.
	messageCategoryListView window: (0 @ 0 extent: 100 @ 70).
	topView addSubView: messageCategoryListView below: classListView.

	messageListView := PluggableListView on: self
		list: #messageList
		selected: #messageListIndex
		changeSelected: #messageListIndex:
		menu: #messageListMenu:shifted:
		keystroke: #messageListKey:from:.
	messageListView menuTitleSelector: #messageListSelectorTitle.
	messageListView window: (0 @ 0 extent: 100 @ 70).
	topView addSubView: messageListView toRightOf: messageCategoryListView.

	switchView := self buildInstanceClassSwitchView.
	switchView borderWidth: 1.
	switchView 
		window: switchView window 
		viewport: (classListView viewport topRight 
					corner: messageListView viewport topRight).
	topView addSubView: switchView toRightOf: classListView.

	 self wantsAnnotationPane
		ifTrue:
			[annotationPane := PluggableTextView on: self
				text: #annotation accept: nil
				readSelection: nil menu: nil.
			annotationPane window: (0@0 extent: 200@self optionalAnnotationHeight).
			topView addSubView: annotationPane below: messageCategoryListView.
			underPane := annotationPane.
			y := (200-12-70) - self optionalAnnotationHeight]
		ifFalse:
			[underPane := messageCategoryListView.
			y := (200-12-70)].

	self wantsOptionalButtons ifTrue:
		[optionalButtonsView := self buildOptionalButtonsView.
		optionalButtonsView borderWidth: 1.
		topView addSubView: optionalButtonsView below: underPane.
		underPane := optionalButtonsView.
		y := y - self optionalButtonHeight].

	browserCodeView := MvcTextEditor default on: self 
			text: #contents accept: #contents:notifying:
			readSelection: #contentsSelection menu: #codePaneMenu:shifted:.
	browserCodeView window: (0@0 extent: 200@y).
	topView addSubView: browserCodeView below: underPane.
	aString ifNotNil: [browserCodeView editString: aString.
			browserCodeView hasUnacceptedEdits: true].

	topView setUpdatablePanesFrom: #(messageCategoryList messageList).
	^ topView! !

!Browser methodsFor: 'initialize-release' stamp: 'sd 11/20/2005 21:26'!
openSystemCatEditString: aString
	"Create a pluggable version of all the views for a Browser, including views and controllers.  The top list view is of the currently selected system class category--a single item list."
	| systemCategoryListView classListView messageCategoryListView messageListView browserCodeView topView switchView y annotationPane underPane optionalButtonsView |

	Smalltalk isMorphic ifTrue: [^ self openAsMorphSysCatEditing: aString].

	topView := (StandardSystemView new) model: self.
	topView borderWidth: 1.
		"label and minSize taken care of by caller"

	systemCategoryListView := PluggableListView on: self
		list: #systemCategorySingleton
		selected: #indexIsOne 
		changeSelected: #indexIsOne:
		menu: #systemCatSingletonMenu:
		keystroke: #systemCatSingletonKey:from:.
	systemCategoryListView window: (0 @ 0 extent: 200 @ 12).
	topView addSubView: systemCategoryListView.

	classListView := PluggableListView on: self
		list: #classList
		selected: #classListIndex
		changeSelected: #classListIndex:
		menu: #classListMenu:shifted:
		keystroke: #classListKey:from:.
	classListView window: (0 @ 0 extent: 67 @ 62).
	topView addSubView: classListView below: systemCategoryListView.

	messageCategoryListView := PluggableListView on: self
		list: #messageCategoryList
		selected: #messageCategoryListIndex
		changeSelected: #messageCategoryListIndex:
		menu: #messageCategoryMenu:.
	messageCategoryListView controller terminateDuringSelect: true.
	messageCategoryListView window: (0 @ 0 extent: 66 @ 70).
	topView addSubView: messageCategoryListView toRightOf: classListView.

	switchView := self buildInstanceClassSwitchView.
	switchView 
		window: switchView window 
		viewport: (classListView viewport bottomLeft 
					corner: messageCategoryListView viewport bottomLeft).
	switchView borderWidth: 1.
	topView addSubView: switchView below: classListView.

	messageListView := PluggableListView on: self
		list: #messageList
		selected: #messageListIndex
		changeSelected: #messageListIndex:
		menu: #messageListMenu:shifted:
		keystroke: #messageListKey:from:.
	messageListView menuTitleSelector: #messageListSelectorTitle.
	messageListView window: (0 @ 0 extent: 67 @ 70).
	topView addSubView: messageListView toRightOf: messageCategoryListView.

	 self wantsAnnotationPane
		ifTrue:
			[annotationPane := PluggableTextView on: self
				text: #annotation accept: nil
				readSelection: nil menu: nil.
			annotationPane window: (0@0 extent: 200@self optionalAnnotationHeight).
			topView addSubView: annotationPane below: switchView.
			y := 110 - 12 - self optionalAnnotationHeight.
			underPane := annotationPane]
		ifFalse:
			[y := 110 - 12.
			underPane := switchView].

	self wantsOptionalButtons ifTrue:
		[optionalButtonsView := self buildOptionalButtonsView.
		optionalButtonsView borderWidth: 1.
		topView addSubView: optionalButtonsView below: underPane.
		underPane := optionalButtonsView.
		y := y - self optionalButtonHeight].

	browserCodeView := MvcTextEditor default on: self 
			text: #contents accept: #contents:notifying:
			readSelection: #contentsSelection menu: #codePaneMenu:shifted:.
	browserCodeView window: (0@0 extent: 200@y).
	topView addSubView: browserCodeView below: underPane.
	aString ifNotNil: [browserCodeView editString: aString.
			browserCodeView hasUnacceptedEdits: true].
	topView setUpdatablePanesFrom: #(classList messageCategoryList messageList).
	^ topView! !

!Browser methodsFor: 'initialize-release' stamp: 'sbw 12/8/1999 12:37'!
optionalAnnotationHeight

	^ 10! !

!Browser methodsFor: 'initialize-release' stamp: 'sbw 12/8/1999 12:23'!
optionalButtonHeight

	^ 10! !

!Browser methodsFor: 'initialize-release' stamp: 'sd 11/20/2005 21:26'!
setClass: aBehavior selector: aSymbol
	"Set the state of a new, uninitialized Browser."

	| isMeta aClass messageCatIndex |
	aBehavior ifNil: [^ self].
	(aBehavior isKindOf: Metaclass)
		ifTrue: [
			isMeta := true.
			aClass := aBehavior soleInstance]
		ifFalse: [
			isMeta := false.
			aClass := aBehavior].
	self selectCategoryForClass: aClass.
	self classListIndex: (
		(systemOrganizer listAtCategoryNamed: self selectedSystemCategoryName)
			indexOf: aClass name).
	self metaClassIndicated: isMeta.
	aSymbol ifNil: [^ self].
	messageCatIndex := aBehavior organization numberOfCategoryOfElement: aSymbol.
	self messageCategoryListIndex: (messageCatIndex > 0
		ifTrue: [messageCatIndex + 1]
		ifFalse: [0]).
	messageCatIndex = 0 ifTrue: [^ self].
	self messageListIndex: (
		(aBehavior organization listAtCategoryNumber: messageCatIndex)
			indexOf: aSymbol).! !

!Browser methodsFor: 'initialize-release' stamp: 'sd 11/20/2005 21:26'!
setSelector: aSymbol
	"Make the receiver point at the given selector, in the currently chosen class"

	| aClass messageCatIndex |
	aSymbol ifNil: [^ self].
	(aClass := self selectedClassOrMetaClass) ifNil: [^ self].
	messageCatIndex := aClass organization numberOfCategoryOfElement: aSymbol.
	self messageCategoryListIndex: messageCatIndex + 1.
	messageCatIndex = 0 ifTrue: [^ self].
	self messageListIndex:
			((aClass organization listAtCategoryNumber: messageCatIndex)
					indexOf: aSymbol)! !

!Browser methodsFor: 'initialize-release' stamp: 'sw 11/8/1999 13:36'!
systemCatSingletonKey: aChar from: aView
	^ self messageListKey: aChar from: aView! !

!Browser methodsFor: 'initialize-release' stamp: 'sd 11/20/2005 21:26'!
systemOrganizer: aSystemOrganizer
	"Initialize the receiver as a perspective on the system organizer, 
	aSystemOrganizer. Typically there is only one--the system variable 
	SystemOrganization."
	
	contents := nil.
	systemOrganizer := aSystemOrganizer.
	systemCategoryListIndex := 0.
	classListIndex := 0.
	messageCategoryListIndex := 0.
	messageListIndex := 0.
	metaClassIndicated := false.
	self setClassOrganizer.
	self editSelection: #none.! !


!Browser methodsFor: 'message category functions' stamp: 'sd 11/20/2005 21:26'!
addCategory
	"Present a choice of categories or prompt for a new category name and add it before the current selection, or at the end if no current selection"
	| labels reject lines cats menuIndex oldIndex newName |
	self okToChange ifFalse: [^ self].
	classListIndex = 0 ifTrue: [^ self].
	labels := OrderedCollection with: 'new...'.
	reject := Set new.
	reject
		addAll: self selectedClassOrMetaClass organization categories;
		add: ClassOrganizer nullCategory;
		add: ClassOrganizer default.
	lines := OrderedCollection new.
	self selectedClassOrMetaClass allSuperclasses do: [:cls |
		cls = Object ifFalse: [
			cats := cls organization categories reject:
				 [:cat | reject includes: cat].
			cats isEmpty ifFalse: [
				lines add: labels size.
				labels addAll: cats asSortedCollection.
				reject addAll: cats]]].
	newName := (labels size = 1 or: [
		menuIndex := (UIManager default chooseFrom: labels lines: lines title: 'Add Category').
		menuIndex = 0 ifTrue: [^ self].
		menuIndex = 1])
			ifTrue: [
				self request: 'Please type new category name'
					initialAnswer: 'category name']
			ifFalse: [
				labels at: menuIndex].
	oldIndex := messageCategoryListIndex.
	newName isEmpty
		ifTrue: [^ self]
		ifFalse: [newName := newName asSymbol].
	self classOrMetaClassOrganizer
		addCategory: newName
		before: (messageCategoryListIndex = 0
				ifTrue: [nil]
				ifFalse: [self selectedMessageCategoryName]).
	self changed: #messageCategoryList.
	self messageCategoryListIndex:
		(oldIndex = 0
			ifTrue: [self classOrMetaClassOrganizer categories size + 1]
			ifFalse: [oldIndex]).
	self changed: #messageCategoryList.
! !

!Browser methodsFor: 'message category functions' stamp: 'NS 4/7/2004 22:47'!
alphabetizeMessageCategories
	classListIndex = 0 ifTrue: [^ false].
	self okToChange ifFalse: [^ false].
	self classOrMetaClassOrganizer sortCategories.
	self clearUserEditFlag.
	self editClass.
	self classListIndex: classListIndex.
	^ true! !

!Browser methodsFor: 'message category functions'!
buildMessageCategoryBrowser
	"Create and schedule a message category browser for the currently 
	selected message category."

	self buildMessageCategoryBrowserEditString: nil! !

!Browser methodsFor: 'message category functions' stamp: 'sd 11/20/2005 21:26'!
buildMessageCategoryBrowserEditString: aString 
	"Create and schedule a message category browser for the currently 
	selected	 message category. The initial text view contains the characters 
	in aString."
	"wod 6/24/1998: set newBrowser classListIndex so that it works whether the
	receiver is a standard or a Hierarchy Browser."

	| newBrowser |
	messageCategoryListIndex ~= 0
		ifTrue: 
			[newBrowser := Browser new.
			newBrowser systemCategoryListIndex: systemCategoryListIndex.
			newBrowser classListIndex: (newBrowser classList indexOf: self selectedClassName).
			newBrowser metaClassIndicated: metaClassIndicated.
			newBrowser messageCategoryListIndex: messageCategoryListIndex.
			newBrowser messageListIndex: messageListIndex.
			self class openBrowserView: (newBrowser openMessageCatEditString: aString)
				label: 'Message Category Browser (' , 
						newBrowser selectedClassOrMetaClassName , ')']! !

!Browser methodsFor: 'message category functions' stamp: 'sw 10/8/2001 14:10'!
canShowMultipleMessageCategories
	"Answer whether the receiver is capable of showing multiple message categories"

	^ true! !

!Browser methodsFor: 'message category functions' stamp: 'sw 10/8/2001 14:10'!
sourceStringPrettifiedAndDiffed
	"Answer a copy of the source code for the selected message, transformed by diffing and pretty-printing exigencies"

	| class selector sourceString |
	class := self selectedClassOrMetaClass.
	selector := self selectedMessageName.
	(class isNil or: [selector isNil]) ifTrue: [^'missing'].
	sourceString := class ultimateSourceCodeAt: selector ifAbsent: [^'error'].
	"self validateMessageSource: sourceString forSelector: selector.
	(#(#prettyPrint #colorPrint #prettyDiffs) 
		includes: contentsSymbol) 
			ifTrue: 
				[sourceString := class prettyPrinterClass 
							format: sourceString
							in: class
							notifying: nil
							contentsSymbol: contentsSymbol].
	self showingAnyKindOfDiffs 
		ifTrue: [sourceString := self diffFromPriorSourceFor: sourceString]."
	^sourceString! !


!Browser methodsFor: 'message category functions' stamp: 'sd 11/20/2005 21:26'!
categoryOfCurrentMethod
	"Determine the method category associated with the receiver at the current moment, or nil if none"

	| aCategory |
	^ self superCategoryOfCurrentMethod ifNil:
		[(aCategory := self messageCategoryListSelection) == ClassOrganizer allCategory
					ifTrue:
						[nil]
					ifFalse:
						[aCategory]]! !

!Browser methodsFor: 'message category functions' stamp: 'NS 4/7/2004 22:56'!
changeMessageCategories: aString 
	"The characters in aString represent an edited version of the the message 
	categories for the selected class. Update this information in the system 
	and inform any dependents that the categories have been changed. This 
	message is invoked because the user had issued the categories command 
	and edited the message categories. Then the user issued the accept 
	command."

	self classOrMetaClassOrganizer changeFromString: aString.
	self clearUserEditFlag.
	self editClass.
	self classListIndex: classListIndex.
	^ true! !

!Browser methodsFor: 'message category functions' stamp: 'nk 2/14/2004 15:06'!
editMessageCategories
	"Indicate to the receiver and its dependents that the message categories of 
	the selected class have been changed."

	self okToChange ifFalse: [^ self].
	classListIndex ~= 0
		ifTrue: 
			[self messageCategoryListIndex: 0.
			self editSelection: #editMessageCategories.
			self changed: #editMessageCategories.
			self contentsChanged]! !

!Browser methodsFor: 'message category functions' stamp: 'tk 4/2/98 13:53'!
fileOutMessageCategories
	"Print a description of the selected message category of the selected class 
	onto an external file."

Cursor write showWhile:
	[messageCategoryListIndex ~= 0
		ifTrue: 
			[self selectedClassOrMetaClass fileOutCategory: self selectedMessageCategoryName]]! !

!Browser methodsFor: 'message category functions' stamp: 'emm 5/30/2002 09:20'!
highlightMessageList: list with: morphList
	"Changed by emm to add emphasis in case of breakpoint"

	morphList do:[:each | 
		| classOrNil methodOrNil |
		classOrNil := self selectedClassOrMetaClass.
		methodOrNil := classOrNil isNil
			ifTrue:[nil]
			ifFalse:[classOrNil methodDictionary at: each contents ifAbsent:[]].
		(methodOrNil notNil and:[methodOrNil hasBreakpoint])
			ifTrue:[each contents: ((each contents ,' [break]') asText allBold)]]! !

!Browser methodsFor: 'message category functions' stamp: 'rr 8/19/2005 14:44'!
messageCategoryMenu: aMenu

	ServiceGui browser: self messageCategoryMenu: aMenu.
	Preferences useOnlyServicesInMenu ifTrue: [^aMenu].
^ aMenu labels:
'browse
printOut
fileOut
reorganize
alphabetize
remove empty categories
categorize all uncategorized
new category...
rename...
remove'
	lines: #(3 8)
	selections:
		#(buildMessageCategoryBrowser printOutMessageCategories fileOutMessageCategories
		editMessageCategories alphabetizeMessageCategories removeEmptyCategories
		categorizeAllUncategorizedMethods addCategory renameCategory removeMessageCategory)
! !

!Browser methodsFor: 'message category functions' stamp: 'tk 4/2/98 13:53'!
printOutMessageCategories
	"Print a description of the selected message category of the selected class 
	onto an external file in Html format."

Cursor write showWhile:
	[messageCategoryListIndex ~= 0
		ifTrue: 
			[self selectedClassOrMetaClass fileOutCategory: self selectedMessageCategoryName
										asHtml: true]]! !

!Browser methodsFor: 'message category functions' stamp: 'nk 4/23/2004 09:18'!
removeEmptyCategories
	self okToChange ifFalse: [^ self].
	self selectedClassOrMetaClass organization removeEmptyCategories.
	self changed: #messageCategoryList
! !

!Browser methodsFor: 'message category functions' stamp: 'sd 11/20/2005 21:26'!
removeMessageCategory
	"If a message category is selected, create a Confirmer so the user can 
	verify that the currently selected message category should be removed
 	from the system. If so, remove it."

	| messageCategoryName |
	messageCategoryListIndex = 0 ifTrue: [^ self].
	self okToChange ifFalse: [^ self].
	messageCategoryName := self selectedMessageCategoryName.
	(self messageList size = 0
		or: [self confirm: 'Are you sure you want to
remove this method category 
and all its methods?'])
		ifTrue: 
			[self selectedClassOrMetaClass removeCategory: messageCategoryName.
			self messageCategoryListIndex: 0.
			self changed: #classSelectionChanged].
	self changed: #messageCategoryList.
! !

!Browser methodsFor: 'message category functions' stamp: 'sd 11/20/2005 21:26'!
renameCategory
	"Prompt for a new category name and add it before the
	current selection, or at the end if no current selection"
	| oldIndex oldName newName |
	classListIndex = 0 ifTrue: [^ self].
	self okToChange ifFalse: [^ self].
	(oldIndex := messageCategoryListIndex) = 0 ifTrue: [^ self].
	oldName := self selectedMessageCategoryName.
	newName := self
		request: 'Please type new category name'
		initialAnswer: oldName.
	newName isEmpty
		ifTrue: [^ self]
		ifFalse: [newName := newName asSymbol].
	newName = oldName ifTrue: [^ self].
	self classOrMetaClassOrganizer
		renameCategory: oldName
		toBe: newName.
	self classListIndex: classListIndex.
	self messageCategoryListIndex: oldIndex.
	self changed: #messageCategoryList.
! !

!Browser methodsFor: 'message category functions' stamp: 'sd 11/20/2005 21:26'!
showHomeCategory
	"Show the home category of the selected method.  This is only really useful if one is in a tool that supports the showing of categories.  Thus, it's good in browsers and hierarchy browsers but not in message-list browsers"

	| aSelector |
	self okToChange ifTrue:
		[(aSelector := self selectedMessageName) ifNotNil:
			[self selectOriginalCategoryForCurrentMethod.
			self selectedMessageName: aSelector]]! !


!Browser methodsFor: 'message category list' stamp: 'sd 11/20/2005 21:26'!
categorizeAllUncategorizedMethods
	"Categorize methods by looking in parent classes for a method category."

	| organizer organizers |
	organizer := self classOrMetaClassOrganizer.
	organizers := self selectedClassOrMetaClass withAllSuperclasses collect: [:ea | ea organization].
	(organizer listAtCategoryNamed: ClassOrganizer default) do: [:sel | | found |
		found := (organizers collect: [ :org | org categoryOfElement: sel])
			detect: [:ea | ea ~= ClassOrganizer default and: [ ea ~= nil]]
			ifNone: [].
		found ifNotNil: [organizer classify: sel under: found]].

	self changed: #messageCategoryList! !

!Browser methodsFor: 'message category list' stamp: 'sd 11/20/2005 21:26'!
messageCatListSingleton

	| name |
	name := self selectedMessageCategoryName.
	^ name ifNil: [Array new]
		ifNotNil: [Array with: name]! !

!Browser methodsFor: 'message category list' stamp: 'ccn 3/22/1999 17:56'!
messageCategoryList
	"Answer the selected category of messages."

	classListIndex = 0
		ifTrue: [^ Array new]
		ifFalse: [^ (Array with: ClassOrganizer allCategory), self classOrMetaClassOrganizer categories]! !

!Browser methodsFor: 'message category list'!
messageCategoryListIndex
	"Answer the index of the selected message category."

	^messageCategoryListIndex! !

!Browser methodsFor: 'message category list' stamp: 'sd 11/20/2005 21:26'!
messageCategoryListIndex: anInteger
	"Set the selected message category to be the one indexed by anInteger."

	messageCategoryListIndex := anInteger.
	messageListIndex := 0.
	self changed: #messageCategorySelectionChanged.
	self changed: #messageCategoryListIndex. "update my selection"
	self changed: #messageList.
	self editSelection: (anInteger > 0
		ifTrue: [#newMessage]
		ifFalse: [self classListIndex > 0
			ifTrue: [#editClass]
			ifFalse: [#newClass]]).
	contents := nil.
	self contentsChanged.! !

!Browser methodsFor: 'message category list' stamp: 'ccn 3/24/1999 11:02'!
messageCategoryListSelection
	"Return the selected category name or nil."

	^ ((self messageCategoryList size = 0 
		or: [self messageCategoryListIndex = 0]) 
		or: [self messageCategoryList size < self messageCategoryListIndex])
			ifTrue: [nil]
			ifFalse: [self messageCategoryList at: (self messageCategoryListIndex max: 1)]! !

!Browser methodsFor: 'message category list' stamp: 'sw 10/16/1999 22:56'!
rawMessageCategoryList
	^ classListIndex = 0
		ifTrue: [Array new]
		ifFalse: [self classOrMetaClassOrganizer categories]! !

!Browser methodsFor: 'message category list' stamp: 'nk 4/22/2004 17:59'!
recategorizeMethodSelector: sel 
	"Categorize method named sel by looking in parent classes for a 
	method category. 
	Answer true if recategorized."
	| thisCat |
	self selectedClassOrMetaClass allSuperclasses
		do: [:ea | 
			thisCat := ea organization categoryOfElement: sel.
			(thisCat ~= ClassOrganizer default
					and: [thisCat notNil])
				ifTrue: [self classOrMetaClassOrganizer classify: sel under: thisCat.
					self changed: #messageCategoryList.
					^ true]].
	^ false! !

!Browser methodsFor: 'message category list' stamp: 'nk 6/13/2004 06:20'!
selectMessageCategoryNamed: aSymbol 
	"Given aSymbol, select the category with that name.  Do nothing if 
	aSymbol doesn't exist."
	self messageCategoryListIndex: (self messageCategoryList indexOf: aSymbol ifAbsent: [ 1])! !

!Browser methodsFor: 'message category list' stamp: 'sd 11/20/2005 21:26'!
selectOriginalCategoryForCurrentMethod
	"private - Select the message category for the current method. 
	 
	 Note:  This should only be called when somebody tries to save  
	 a method that they are modifying while ALL is selected. 
	 
	 Returns: true on success, false on failure."
	| aSymbol selectorName |
	aSymbol := self categoryOfCurrentMethod.
	selectorName := self selectedMessageName.
	(aSymbol notNil and: [aSymbol ~= ClassOrganizer allCategory])
		ifTrue: 
			[messageCategoryListIndex := (self messageCategoryList indexOf: aSymbol).
			messageListIndex := (self messageList indexOf: selectorName).
			self changed: #messageCategorySelectionChanged.
			self changed: #messageCategoryListIndex.	"update my selection"
			self changed: #messageList.
			self changed: #messageListIndex.
			^ true].
	^ false! !

!Browser methodsFor: 'message category list'!
selectedMessageCategoryName
	"Answer the name of the selected message category, if any. Answer nil 
	otherwise."

	messageCategoryListIndex = 0 ifTrue: [^nil].
	^self messageCategoryList at: messageCategoryListIndex! !

!Browser methodsFor: 'message category list' stamp: 'sd 11/20/2005 21:26'!
setOriginalCategoryIndexForCurrentMethod
	"private - Set the message category index for the currently selected method. 
	 
	 Note:  This should only be called when somebody tries to save  
	 a method that they are modifying while ALL is selected."

	messageCategoryListIndex := self messageCategoryList indexOf: self categoryOfCurrentMethod
	! !

!Browser methodsFor: 'message category list'!
toggleMessageCategoryListIndex: anInteger 
	"If the currently selected message category index is anInteger, deselect 
	the category. Otherwise select the category whose index is anInteger."

	self messageCategoryListIndex: 
		(messageCategoryListIndex = anInteger
			ifTrue: [0]
			ifFalse: [anInteger])! !


!Browser methodsFor: 'message functions' stamp: 'sw 1/11/2001 07:22'!
addExtraShiftedItemsTo: aMenu
	"The shifted selector-list menu is being built; some menu items are appropriate only for certain kinds of browsers, and this gives a hook for them to be added as approrpiate.  If any is added here, a line should be added first -- browse reimplementors of this message for examples."
! !

!Browser methodsFor: 'message functions'!
buildMessageBrowser
	"Create and schedule a message browser on the currently selected 
	message. Do nothing if no message is selected. The initial text view 
	contains nothing."

	self buildMessageBrowserEditString: nil! !

!Browser methodsFor: 'message functions' stamp: 'sd 1/5/2002 21:11'!
buildMessageBrowserEditString: aString 
	"Create and schedule a message browser for the receiver in which the 
	argument, aString, contains characters to be edited in the text view."

	messageListIndex = 0 ifTrue: [^ self].
	^ self class openMessageBrowserForClass: self selectedClassOrMetaClass 
		selector: self selectedMessageName editString: aString! !

!Browser methodsFor: 'message functions' stamp: 'sd 11/20/2005 21:26'!
defineMessage: aString notifying: aController 
	"Compile the expressions in aString. Notify aController if a syntax error 
	occurs. Install the compiled method in the selected class classified under 
	the currently selected message category name. Answer true if 
	compilation succeeds, false otherwise."
	| selectedMessageName selector category oldMessageList |
	selectedMessageName := self selectedMessageName.
	oldMessageList := self messageList.
	contents := nil.
	selector := self selectedClassOrMetaClass
				compile: aString
				classified: (category := self selectedMessageCategoryName)
				notifying: aController.
	selector == nil ifTrue: [^ false].
	contents := aString copy.
	selector ~~ selectedMessageName
		ifTrue: 
			[category = ClassOrganizer nullCategory
				ifTrue: [self changed: #classSelectionChanged.
						self changed: #classList.
						self messageCategoryListIndex: 1].
			self setClassOrganizer.  "In case organization not cached"
			(oldMessageList includes: selector)
				ifFalse: [self changed: #messageList].
			self messageListIndex: (self messageList indexOf: selector)].
	^ true! !

!Browser methodsFor: 'message functions' stamp: 'md 2/20/2006 18:42'!
defineMessageFrom: aString notifying: aController
	"Compile the expressions in aString. Notify aController if a syntax error occurs. Install the compiled method in the selected class classified under  the currently selected message category name. Answer the selector obtained if compilation succeeds, nil otherwise."
	| selectedMessageName selector category oldMessageList |
	selectedMessageName := self selectedMessageName.
	oldMessageList := self messageList.
	contents := nil.
	selector := (self selectedClassOrMetaClass parserClass new parseSelector: aString).
	(self metaClassIndicated
		and: [(self selectedClassOrMetaClass includesSelector: selector) not
		and: [Metaclass isScarySelector: selector]])
		ifTrue: ["A frist-time definition overlaps the protocol of Metaclasses"
				(self confirm: ((selector , ' is used in the existing class system.
Overriding it could cause serious problems.
Is this really what you want to do?') asText makeBoldFrom: 1 to: selector size))
				ifFalse: [^nil]].
	selector := self selectedClassOrMetaClass
				compile: aString
				classified: (category := self selectedMessageCategoryName)
				notifying: aController.
	selector == nil ifTrue: [^ nil].
	contents := aString copy.
	selector ~~ selectedMessageName
		ifTrue: 
			[category = ClassOrganizer nullCategory
				ifTrue: [self changed: #classSelectionChanged.
						self changed: #classList.
						self messageCategoryListIndex: 1].
			self setClassOrganizer.  "In case organization not cached"
			(oldMessageList includes: selector)
				ifFalse: [self changed: #messageList].
			self messageListIndex: (self messageList indexOf: selector)].
	^ selector! !

!Browser methodsFor: 'message functions' stamp: 'al 4/24/2004 12:48'!
inspectInstances
	"Inspect all instances of the selected class.  1/26/96 sw"

	| myClass |
	((myClass _ self selectedClassOrMetaClass) isNil or: [myClass isTrait])
		ifFalse: [myClass theNonMetaClass inspectAllInstances]
! !

!Browser methodsFor: 'message functions' stamp: 'al 4/24/2004 12:48'!
inspectSubInstances
	"Inspect all instances of the selected class and all its subclasses  1/26/96 sw"

	| aClass |
	((aClass _ self selectedClassOrMetaClass) isNil or: [aClass isTrait])
		ifFalse: [
			aClass _ aClass theNonMetaClass.
			aClass inspectSubInstances].
! !

!Browser methodsFor: 'message functions' stamp: 'rr 8/19/2005 14:45'!
messageListMenu: aMenu shifted: shifted
	"Answer the message-list menu"
	"Changed by emm to include menu-item for breakpoints"

	ServiceGui browser: self messageListMenu: aMenu.
	Preferences useOnlyServicesInMenu ifTrue: [^aMenu].
	shifted ifTrue: [^ self shiftedMessageListMenu: aMenu].

	aMenu addList:#(
			('what to show...'			offerWhatToShowMenu)
                	('toggle break on entry'		toggleBreakOnEntry)
            		-
			('browse full (b)' 			browseMethodFull)
			('browse hierarchy (h)'			classHierarchy)
			('browse method (O)'			openSingleMessageBrowser)
			('browse protocol (p)'			browseFullProtocol)
			-
			('fileOut'				fileOutMessage)
			('printOut'				printOutMessage)
			-
			('senders of... (n)'			browseSendersOfMessages)
			('implementors of... (m)'		browseMessages)
			('inheritance (i)'			methodHierarchy)
			('tile scriptor'			openSyntaxView)
			('versions (v)'				browseVersions)
			-
			('inst var refs...'			browseInstVarRefs)
			('inst var defs...'			browseInstVarDefs)
			('class var refs...'			browseClassVarRefs)
			('class variables'			browseClassVariables)
			('class refs (N)'			browseClassRefs)
			-
			('remove method (x)'			removeMessage)
			-
			('more...'				shiftedYellowButtonActivity)).
	^ aMenu
! !

!Browser methodsFor: 'message functions' stamp: 'al 4/24/2004 11:49'!
removeMessage
	"If a message is selected, create a Confirmer so the user can verify that  
	the currently selected message should be removed from the system. If 
	so,  
	remove it. If the Preference 'confirmMethodRemoves' is set to false, the 
	confirmer is bypassed."
	| messageName confirmation |
	messageListIndex = 0
		ifTrue: [^ self].
	self okToChange
		ifFalse: [^ self].
	messageName _ self selectedMessageName.
	confirmation _ self systemNavigation   confirmRemovalOf: messageName on: self selectedClassOrMetaClass.
	confirmation == 3
		ifTrue: [^ self].
	(self selectedClassOrMetaClass includesLocalSelector: messageName)
		ifTrue: [self selectedClassOrMetaClass removeSelector: messageName]
		ifFalse: [self removeNonLocalSelector: messageName].
	self messageListIndex: 0.
	self changed: #messageList.
	self setClassOrganizer.
	"In case organization not cached"
	confirmation == 2
		ifTrue: [self systemNavigation browseAllCallsOn: messageName]! !

!Browser methodsFor: 'message functions' stamp: 'tk 4/2/98 17:03'!
removeMessageFromBrowser
	"Our list speaks the truth and can't have arbitrary things removed"

	^ self changed: #flash! !

!Browser methodsFor: 'message functions' stamp: 'md 7/29/2005 15:59'!
shiftedMessageListMenu: aMenu
	"Fill aMenu with the items appropriate when the shift key is held down"

	Smalltalk isMorphic ifTrue: [aMenu addStayUpItem].
	aMenu addList: #(
		('method pane' 							makeIsolatedCodePane)
		('tile scriptor'							openSyntaxView)
		('toggle diffing (D)'						toggleDiffing)
		('implementors of sent messages'			browseAllMessages)
		-
		('local senders of...'						browseLocalSendersOfMessages)
		('local implementors of...'				browseLocalImplementors)
		-
		('spawn sub-protocol'					spawnProtocol)
		('spawn full protocol'					spawnFullProtocol)
		-
		('sample instance'						makeSampleInstance)
		('inspect instances'						inspectInstances)
		('inspect subinstances'					inspectSubInstances)).

	self addExtraShiftedItemsTo: aMenu.
	aMenu addList: #(
		-
		('change category...'					changeCategory)).

	self canShowMultipleMessageCategories ifTrue: [aMenu addList:
		 #(('show category (C)'						showHomeCategory))].
	aMenu addList: #(
		-
		('change sets with this method'			findMethodInChangeSets)
		('revert to previous version'				revertToPreviousVersion)
		('remove from current change set'		removeFromCurrentChanges)
		('revert & remove from changes'		revertAndForget)
		('add to current change set'				adoptMessageInCurrentChangeset)
		('copy up or copy down...'				copyUpOrCopyDown)
		-
		('more...' 								unshiftedYellowButtonActivity)).
	^ aMenu
! !


!Browser methodsFor: 'message list' stamp: 'sd 11/20/2005 21:26'!
messageList
	"Answer an Array of the message selectors of the currently selected message category, provided that the messageCategoryListIndex is in proper range.  Otherwise, answer an empty Array  If messageCategoryListIndex is found to be larger than the number of categories (it happens!!), it is reset to zero."
	| sel |
	(sel := self messageCategoryListSelection) ifNil: 
		[
			^ self classOrMetaClassOrganizer
				ifNil:		[Array new]
				ifNotNil:	[self classOrMetaClassOrganizer allMethodSelectors]
			"^ Array new"
		].

	^ sel = ClassOrganizer allCategory
		ifTrue: 
			[self classOrMetaClassOrganizer
				ifNil:		[Array new]
				ifNotNil:	[self classOrMetaClassOrganizer allMethodSelectors]]
		ifFalse:
			[(self classOrMetaClassOrganizer listAtCategoryNumber: messageCategoryListIndex - 1)
				ifNil: [messageCategoryListIndex := 0.  Array new]]! !

!Browser methodsFor: 'message list'!
messageListIndex
	"Answer the index of the selected message selector into the currently 
	selected message category."

	^messageListIndex! !

!Browser methodsFor: 'message list' stamp: 'sd 11/20/2005 21:26'!
messageListIndex: anInteger
	"Set the selected message selector to be the one indexed by anInteger."

	messageListIndex := anInteger.
	self editSelection: (anInteger > 0
		ifTrue: [#editMessage]
		ifFalse: [self messageCategoryListIndex > 0
			ifTrue: [#newMessage]
			ifFalse: [self classListIndex > 0
				ifTrue: [#editClass]
				ifFalse: [#newClass]]]).
	contents := nil.
	self changed: #messageListIndex. "update my selection"
	self contentsChanged.! !

!Browser methodsFor: 'message list' stamp: 'sd 11/20/2005 21:26'!
messageListSingleton

	| name |
	name := self selectedMessageName.
	^ name ifNil: [Array new]
		ifNotNil: [Array with: name]! !

!Browser methodsFor: 'message list' stamp: 'sw 12/1/2000 11:17'!
reformulateList
	"If the receiver has a way of reformulating its message list, here is a chance for it to do so"

	super reformulateList.
	self messageListIndex: 0! !

!Browser methodsFor: 'message list' stamp: 'md 2/20/2006 15:01'!
selectedMessage
	"Answer a copy of the source code for the selected message."

	| class selector method |
	contents == nil ifFalse: [^ contents copy].

	"self showingDecompile ifTrue:
		[^ self decompiledSourceIntoContents]."

	class := self selectedClassOrMetaClass.
	selector := self selectedMessageName.
	method := class compiledMethodAt: selector ifAbsent: [^ ''].	"method deleted while in another project"
	currentCompiledMethod := method.

	^ contents := (self sourceStringPrettifiedAndDiffed)
			copy asText makeSelectorBoldIn: class! !

!Browser methodsFor: 'message list' stamp: 'sd 11/20/2005 21:26'!
selectedMessageName
	"Answer the message selector of the currently selected message, if any. 
	Answer nil otherwise."

	| aList |
	messageListIndex = 0 ifTrue: [^ nil].
	^ (aList := self messageList) size >= messageListIndex
		ifTrue:
			[aList at: messageListIndex]
		ifFalse:
			[nil]! !

!Browser methodsFor: 'message list' stamp: 'sd 11/20/2005 21:26'!
selectedMessageName: aSelector
	"Make the given selector be the selected message name"

	| anIndex |
	anIndex := self messageList indexOf: aSelector.
	anIndex > 0 ifTrue:
		[self messageListIndex: anIndex]! !

!Browser methodsFor: 'message list'!
toggleMessageListIndex: anInteger 
	"If the currently selected message index is anInteger, deselect the message 
	selector. Otherwise select the message selector whose index is anInteger."

	self messageListIndex: 
		(messageListIndex = anInteger
			ifTrue: [0]
			ifFalse: [anInteger])! !


!Browser methodsFor: 'metaclass' stamp: 'di 1/14/98 12:25'!
classCommentIndicated
	"Answer true iff we're viewing the class comment."

	^ editSelection == #editComment 
! !

!Browser methodsFor: 'metaclass' stamp: 'ak 11/24/2000 21:46'!
classMessagesIndicated
	"Answer whether the messages to be presented should come from the 
	metaclass."

	^ self metaClassIndicated and: [self classCommentIndicated not]! !

!Browser methodsFor: 'metaclass'!
classOrMetaClassOrganizer
	"Answer the class organizer for the metaclass or class, depending on 
	which (instance or class) is indicated."

	self metaClassIndicated
		ifTrue: [^metaClassOrganizer]
		ifFalse: [^classOrganizer]! !

!Browser methodsFor: 'metaclass'!
indicateClassMessages
	"Indicate that the message selection should come from the metaclass 
	messages."

	self metaClassIndicated: true! !

!Browser methodsFor: 'metaclass'!
indicateInstanceMessages
	"Indicate that the message selection should come from the class (instance) 
	messages."

	self metaClassIndicated: false! !

!Browser methodsFor: 'metaclass' stamp: 'di 1/14/98 13:20'!
instanceMessagesIndicated
	"Answer whether the messages to be presented should come from the 
	class."

	^metaClassIndicated not and: [self classCommentIndicated not]! !

!Browser methodsFor: 'metaclass' stamp: 'sr 6/21/2000 17:23'!
metaClassIndicated
	"Answer the boolean flag that indicates which of the method dictionaries, 
	class or metaclass."

	^ metaClassIndicated! !

!Browser methodsFor: 'metaclass' stamp: 'sd 11/20/2005 21:26'!
metaClassIndicated: trueOrFalse 
	"Indicate whether browsing instance or class messages."

	metaClassIndicated := trueOrFalse.
	self setClassOrganizer.
	systemCategoryListIndex > 0 ifTrue:
		[self editSelection: (classListIndex = 0
			ifTrue: [metaClassIndicated
				ifTrue: [#none]
				ifFalse: [#newClass]]
			ifFalse: [#editClass])].
	messageCategoryListIndex := 0.
	messageListIndex := 0.
	contents := nil.
	self changed: #classSelectionChanged.
	self changed: #messageCategoryList.
	self changed: #messageList.
	self changed: #contents.
	self changed: #annotation.
! !

!Browser methodsFor: 'metaclass' stamp: 'al 4/24/2004 11:47'!
selectedClassOrMetaClass
	"Answer the selected class/trait or metaclass/classTrait."

	| cls |
	^self metaClassIndicated
		ifTrue: [(cls _ self selectedClass) ifNil: [nil] ifNotNil: [cls classSide]]
		ifFalse: [self selectedClass]! !

!Browser methodsFor: 'metaclass'!
selectedClassOrMetaClassName
	"Answer the selected class name or metaclass name."

	^self selectedClassOrMetaClass name! !

!Browser methodsFor: 'metaclass' stamp: 'md 2/18/2006 16:31'!
setClassOrganizer
	"Install whatever organization is appropriate"
	| theClass |
	classOrganizer _ nil.
	metaClassOrganizer _ nil.
	classListIndex = 0 ifTrue: [^ self].
	theClass _ self selectedClass ifNil: [ ^self ].
	classOrganizer _ theClass organization.
	metaClassOrganizer _ theClass classSide organization.! !


!Browser methodsFor: 'system category functions' stamp: 'sd 11/20/2005 21:26'!
addSystemCategory
	"Prompt for a new category name and add it before the
	current selection, or at the end if no current selection"
	| oldIndex newName |
	self okToChange ifFalse: [^ self].
	oldIndex := systemCategoryListIndex.
	newName := self
		request: 'Please type new category name'
		initialAnswer: 'Category-Name'.
	newName isEmpty
		ifTrue: [^ self]
		ifFalse: [newName := newName asSymbol].
	systemOrganizer
		addCategory: newName
		before: (systemCategoryListIndex = 0
				ifTrue: [nil]
				ifFalse: [self selectedSystemCategoryName]).
	self systemCategoryListIndex:
		(oldIndex = 0
			ifTrue: [self systemCategoryList size]
			ifFalse: [oldIndex]).
	self changed: #systemCategoryList.! !

!Browser methodsFor: 'system category functions' stamp: 'brp 8/4/2003 21:38'!
alphabetizeSystemCategories

	self okToChange ifFalse: [^ false].
	systemOrganizer sortCategories.
	self systemCategoryListIndex: 0.
	self changed: #systemCategoryList.
! !

!Browser methodsFor: 'system category functions' stamp: 'sd 11/20/2005 21:26'!
browseAllClasses
	"Create and schedule a new browser on all classes alphabetically."
	| newBrowser |
	newBrowser := HierarchyBrowser new initAlphabeticListing.
	self class openBrowserView: (newBrowser openSystemCatEditString: nil)
		label: 'All Classes Alphabetically'! !

!Browser methodsFor: 'system category functions'!
buildSystemCategoryBrowser
	"Create and schedule a new system category browser."

	self buildSystemCategoryBrowserEditString: nil! !

!Browser methodsFor: 'system category functions' stamp: 'sd 11/20/2005 21:26'!
buildSystemCategoryBrowserEditString: aString 
	"Create and schedule a new system category browser with initial textual 
	contents set to aString."

	| newBrowser |
	systemCategoryListIndex > 0
		ifTrue: 
			[newBrowser := self class new.
			newBrowser systemCategoryListIndex: systemCategoryListIndex.
			newBrowser setClass: self selectedClassOrMetaClass selector: self selectedMessageName.
			self class openBrowserView: (newBrowser openSystemCatEditString: aString)
				label: 'Classes in category ', newBrowser selectedSystemCategoryName]! !

!Browser methodsFor: 'system category functions' stamp: 'di 4/12/98 13:21'!
changeSystemCategories: aString 
	"Update the class categories by parsing the argument aString."

	systemOrganizer changeFromString: aString.
	self changed: #systemCategoryList.
	^ true! !

!Browser methodsFor: 'system category functions' stamp: 'tk 4/2/98 13:43'!
classNotFound

	self changed: #flash.! !

!Browser methodsFor: 'system category functions' stamp: 'nk 2/14/2004 15:09'!
editSystemCategories
	"Retrieve the description of the class categories of the system organizer."

	self okToChange ifFalse: [^ self].
	self systemCategoryListIndex: 0.
	self editSelection: #editSystemCategories.
	self changed: #editSystemCategories.
	self contentsChanged! !

!Browser methodsFor: 'system category functions' stamp: 'tk 3/31/98 07:52'!
fileOutSystemCategory
	"Print a description of each class in the selected category onto a file 
	whose name is the category name followed by .st."

	systemCategoryListIndex ~= 0
		ifTrue: [systemOrganizer fileOutCategory: self selectedSystemCategoryName]! !

!Browser methodsFor: 'system category functions' stamp: 'al 1/13/2006 11:24'!
findClass
	"Search for a class by name."
	| pattern foundClassOrTrait |

	self okToChange ifFalse: [^ self classNotFound].
	pattern := UIManager default request: 'Class name or fragment?'.
	pattern isEmpty ifTrue: [^ self classNotFound].
	foundClassOrTrait := Utilities classFromPattern: pattern withCaption: ''.
	foundClassOrTrait ifNil: [^ self classNotFound].
 	self selectCategoryForClass: foundClassOrTrait.
	self selectClass: foundClassOrTrait.
! !

!Browser methodsFor: 'system category functions' stamp: 'sw 11/8/1999 10:04'!
potentialClassNames
	"Answer the names of all the classes that could be viewed in this browser.  This hook is provided so that HierarchyBrowsers can indicate their restricted subset.  For generic Browsers, the entire list of classes known to Smalltalk is provided, though of course that really only is accurate in the case of full system browsers."

	^ Smalltalk classNames! !

!Browser methodsFor: 'system category functions' stamp: 'tk 4/2/98 13:46'!
printOutSystemCategory
	"Print a description of each class in the selected category as Html."

Cursor write showWhile:
	[systemCategoryListIndex ~= 0
		ifTrue: [systemOrganizer fileOutCategory: self selectedSystemCategoryName
								asHtml: true ]]
! !

!Browser methodsFor: 'system category functions' stamp: 'di 4/12/98 13:55'!
removeSystemCategory
	"If a class category is selected, create a Confirmer so the user can 
	verify that the currently selected class category and all of its classes
 	should be removed from the system. If so, remove it."

	systemCategoryListIndex = 0 ifTrue: [^ self].
	self okToChange ifFalse: [^ self].
	(self classList size = 0
		or: [self confirm: 'Are you sure you want to
remove this system category 
and all its classes?'])
		ifTrue: 
		[systemOrganizer removeSystemCategory: self selectedSystemCategoryName.
		self systemCategoryListIndex: 0.
		self changed: #systemCategoryList]! !

!Browser methodsFor: 'system category functions' stamp: 'sd 11/20/2005 21:26'!
renameSystemCategory
	"Prompt for a new category name and add it before the
	current selection, or at the end if no current selection"
	| oldIndex oldName newName |
	(oldIndex := systemCategoryListIndex) = 0
		ifTrue: [^ self].  "no selection"
	self okToChange ifFalse: [^ self].
	oldName := self selectedSystemCategoryName.
	newName := self
		request: 'Please type new category name'
		initialAnswer: oldName.
	newName isEmpty
		ifTrue: [^ self]
		ifFalse: [newName := newName asSymbol].
	oldName = newName ifTrue: [^ self].
	systemOrganizer
		renameCategory: oldName
		toBe: newName.
	self systemCategoryListIndex: oldIndex.
	self changed: #systemCategoryList.! !

!Browser methodsFor: 'system category functions' stamp: 'rr 8/19/2005 14:45'!
systemCategoryMenu: aMenu

	ServiceGui browser: self classCategoryMenu: aMenu.
	Preferences useOnlyServicesInMenu ifTrue: [^aMenu].
^ aMenu labels:
'find class... (f)
recent classes... (r)
browse all
browse
printOut
fileOut
reorganize
alphabetize
update
add item...
rename...
remove' 
	lines: #(2 4 6 8)
	selections:
		#(findClass recent browseAllClasses buildSystemCategoryBrowser
		printOutSystemCategory fileOutSystemCategory
		editSystemCategories alphabetizeSystemCategories updateSystemCategories
		addSystemCategory renameSystemCategory removeSystemCategory )
! !

!Browser methodsFor: 'system category functions' stamp: 'sw 11/8/1999 14:07'!
systemCatSingletonMenu: aMenu

	^ aMenu labels:
'browse all
browse
printOut
fileOut
update
rename...
remove' 
	lines: #(2 4)
	selections:
		#(browseAllClasses buildSystemCategoryBrowser
		printOutSystemCategory fileOutSystemCategory updateSystemCategories
		renameSystemCategory removeSystemCategory)
! !

!Browser methodsFor: 'system category functions' stamp: 'di 4/12/98 13:17'!
updateSystemCategories
	"The class categories were changed in another browser. The receiver must 
	reorganize its lists based on these changes."

	self okToChange ifFalse: [^ self].
	self changed: #systemCategoryList! !


!Browser methodsFor: 'system category list' stamp: 'tk 5/4/1998 15:46'!
indexIsOne
	"When used as a singleton list, index is always one"
	^ 1! !

!Browser methodsFor: 'system category list' stamp: 'tk 5/4/1998 15:46'!
indexIsOne: value
	"When used as a singleton list, can't change it"

	^ self! !

!Browser methodsFor: 'system category list' stamp: 'stp 01/13/2000 12:25'!
selectCategoryForClass: theClass

	self systemCategoryListIndex: (self systemCategoryList indexOf: theClass category)
! !

!Browser methodsFor: 'system category list' stamp: 'md 3/3/2006 11:02'!
selectedEnvironment
	"Answer the name of the selected system category or nil."

	systemCategoryListIndex = 0 ifTrue: [^nil].
	^ Smalltalk! !

!Browser methodsFor: 'system category list'!
selectedSystemCategoryName
	"Answer the name of the selected system category or nil."

	systemCategoryListIndex = 0 ifTrue: [^nil].
	^self systemCategoryList at: systemCategoryListIndex! !

!Browser methodsFor: 'system category list'!
systemCategoryList
	"Answer the class categories modelled by the receiver."

	^systemOrganizer categories! !

!Browser methodsFor: 'system category list'!
systemCategoryListIndex
	"Answer the index of the selected class category."

	^systemCategoryListIndex! !

!Browser methodsFor: 'system category list' stamp: 'sd 11/20/2005 21:26'!
systemCategoryListIndex: anInteger 
	"Set the selected system category index to be anInteger. Update all other 
	selections to be deselected."

	systemCategoryListIndex := anInteger.
	classListIndex := 0.
	messageCategoryListIndex := 0.
	messageListIndex := 0.
	self editSelection: ( anInteger = 0 ifTrue: [#none] ifFalse: [#newClass]).
	metaClassIndicated := false.
	self setClassOrganizer.
	contents := nil.
	self changed: #systemCategorySelectionChanged.
	self changed: #systemCategoryListIndex.	"update my selection"
	self changed: #classList.
	self changed: #messageCategoryList.
	self changed: #messageList.
	self changed: #relabel.
	self contentsChanged! !

!Browser methodsFor: 'system category list' stamp: 'sd 11/20/2005 21:26'!
systemCategorySingleton

	| cat |
	cat := self selectedSystemCategoryName.
	^ cat ifNil: [Array new]
		ifNotNil: [Array with: cat]! !

!Browser methodsFor: 'system category list'!
toggleSystemCategoryListIndex: anInteger 
	"If anInteger is the current system category index, deselect it. Else make 
	it the current system category selection."

	self systemCategoryListIndex: 
		(systemCategoryListIndex = anInteger
			ifTrue: [0]
			ifFalse: [anInteger])! !


!Browser methodsFor: 'toolbuilder' stamp: 'ar 2/12/2005 14:19'!
buildWith: builder
	"Create the ui for the browser"
	| windowSpec listSpec textSpec buttonSpec panelSpec max |
	windowSpec := builder pluggableWindowSpec new.
	windowSpec model: self.
	windowSpec label: 'System Browser'.
	windowSpec children: OrderedCollection new.

	max := self wantsOptionalButtons ifTrue:[0.43] ifFalse:[0.5].
	listSpec := builder pluggableListSpec new.
	listSpec 
		model: self;
		list: #systemCategoryList; 
		getIndex: #systemCategoryListIndex; 
		setIndex: #systemCategoryListIndex:; 
		menu: #systemCategoryMenu:; 
		keyPress: #systemCatListKey:from:;
		frame: (0@0 corner: 0.25@max).
	windowSpec children add: listSpec.

	listSpec := builder pluggableListSpec new.
	listSpec 
		model: self;
		list: #classList; 
		getIndex: #classListIndex; 
		setIndex: #classListIndex:; 
		menu: #classListMenu:; 
		keyPress: #classListKey:from:;
		frame: (0.25@0 corner: 0.5@(max-0.1)).
	windowSpec children add: listSpec.

	panelSpec := builder pluggablePanelSpec new.
	panelSpec frame: (0.25@(max-0.1) corner: 0.5@max).
	panelSpec children: OrderedCollection new.
	windowSpec children addLast: panelSpec.

		buttonSpec := builder pluggableButtonSpec new.
		buttonSpec 
			model: self;
			label: 'instance'; 
			state: #instanceMessagesIndicated; 
			action: #indicateInstanceMessages;
			frame: (0@0 corner: 0.4@1).
		panelSpec children addLast: buttonSpec.

		buttonSpec := builder pluggableButtonSpec new.
		buttonSpec 
			model: self;
			label: '?'; 
			state: #classCommentIndicated; 
			action: #plusButtonHit;
			frame: (0.4@0 corner: 0.6@1).
		panelSpec children addLast: buttonSpec.

		buttonSpec := builder pluggableButtonSpec new.
		buttonSpec 
			model: self;
			label: 'class'; 
			state: #classMessagesIndicated; 
			action: #indicateClassMessages;
			frame: (0.6@0 corner: 1@1).
		panelSpec children addLast: buttonSpec.

	listSpec := builder pluggableListSpec new.
	listSpec 
		model: self;
		list: #messageCategoryList; 
		getIndex: #messageCategoryListIndex; 
		setIndex: #messageCategoryListIndex:; 
		menu: #messageCategoryMenu:; 
		keyPress: #arrowKey:from:;
		frame: (0.5@0 corner: 0.75@max).
	windowSpec children add: listSpec.

	listSpec := builder pluggableListSpec new.
	listSpec 
		model: self;
		list: #messageList; 
		getIndex: #messageListIndex; 
		setIndex: #messageListIndex:; 
		menu: #messageListMenu:shifted:; 
		keyPress: #messageListKey:from:;
		frame: (0.75@0 corner: 1@max).
	windowSpec children add: listSpec.

	self wantsOptionalButtons ifTrue:[
		panelSpec := self buildOptionalButtonsWith: builder.
		panelSpec frame: (0@0.43 corner: 1@0.5).
		windowSpec children add: panelSpec.
	].

	textSpec := builder pluggableTextSpec new.
	textSpec 
		model: self;
		getText: #contents; 
		setText: #contents:notifying:; 
		selection: #contentsSelection; 
		menu: #codePaneMenu:shifted:;
		frame: (0@0.5corner: 1@1).
	windowSpec children add: textSpec.

	^builder build: windowSpec! !


!Browser methodsFor: 'traits' stamp: 'al 1/9/2006 18:29'!
addSpecialMenu: aMenu
	aMenu addList: #(
		-
		('new class'				newClass)
		('new trait'				newTrait)
		-).
	self selectedClass notNil ifTrue: [
		aMenu addList: #(
			('add trait' addTrait)
			-) ].
	aMenu addList: #(-).
	^ aMenu! !

!Browser methodsFor: 'traits' stamp: 'al 1/9/2006 18:26'!
addTrait
	| input trait |
	input := UIManager default request: 'add trait'.
	input isEmptyOrNil ifFalse: [
		trait := Smalltalk classNamed: input.
		(trait isNil or: [trait isTrait not]) ifTrue: [
			^self inform: 'Input invalid. ' , input , ' does not exist or is not a trait'].
		self selectedClass addToComposition: trait.
		self contentsChanged].
! !

!Browser methodsFor: 'traits' stamp: 'md 3/3/2006 10:58'!
defineTrait: defString notifying: aController  

	| defTokens keywdIx envt oldTrait newTraitName trait |
	oldTrait _ self selectedClassOrMetaClass.
	defTokens _ defString findTokens: Character separators.
	keywdIx _ defTokens findFirst: [:x | x = 'category'].
	envt _ self selectedEnvironment.
	keywdIx _ defTokens findFirst: [:x | x = 'named:'].
	newTraitName _ (defTokens at: keywdIx+1) copyWithoutAll: '#()'.
	((oldTrait isNil or: [oldTrait baseTrait name asString ~= newTraitName])
		and: [envt includesKey: newTraitName asSymbol]) ifTrue:
			["Attempting to define new class/trait over existing one when
				not looking at the original one in this browser..."
			(self confirm: ((newTraitName , ' is an existing class/trait in this system.
Redefining it might cause serious problems.
Is this really what you want to do?') asText makeBoldFrom: 1 to: newTraitName size))
				ifFalse: [^ false]].

	trait _ Compiler evaluate: defString notifying: aController logged: true.
	^(trait isKindOf: TraitBehavior)
		ifTrue: [
			self changed: #classList.
			self classListIndex: (self classList indexOf: trait baseTrait name).
			self clearUserEditFlag; editClass.
			true]
		ifFalse: [ false ]
! !

!Browser methodsFor: 'traits' stamp: 'al 4/24/2004 11:48'!
newClass
	(self selectedClassOrMetaClass notNil and: 
		[self selectedClassOrMetaClass isTrait]) ifTrue: [self classListIndex: 0].
	self editClass.
	editSelection _ #newClass.
	self contentsChanged! !

!Browser methodsFor: 'traits' stamp: 'al 4/24/2004 11:48'!
newTrait
	self classListIndex: 0.
	self editClass.
	editSelection _ #newTrait.
	self contentsChanged! !

!Browser methodsFor: 'traits' stamp: 'al 4/24/2004 11:49'!
removeNonLocalSelector: aSymbol
	| traits isAlias |
	traits _ self selectedClassOrMetaClass traitsProvidingSelector: aSymbol.
	isAlias _ self selectedClassOrMetaClass isLocalAliasSelector: aSymbol.
	isAlias
		ifTrue: [
			self assert: traits size = 1.
			self selectedClassOrMetaClass removeAlias: aSymbol of: traits first]
		ifFalse: [
			traits do: [:each |
				self selectedClassOrMetaClass addExclusionOf: aSymbol to: each ]]
	! !


!Browser methodsFor: 'user interface' stamp: 'hpt 9/30/2004 20:51'!
addModelItemsToWindowMenu: aMenu
	"Add model-related items to the window menu"
	super addModelItemsToWindowMenu: aMenu.
	SystemBrowser addRegistryMenuItemsTo: aMenu inAccountOf: self.! !


!Browser methodsFor: '*services-base' stamp: 'rr 6/28/2005 15:50'!
browseReference: ref
	self okToChange ifTrue: [
	self selectCategoryForClass: ref actualClass theNonMetaClass.
	self selectClass: ref actualClass theNonMetaClass .
	ref actualClass isMeta ifTrue: [self indicateClassMessages].
	self changed: #classSelectionChanged.
	self selectMessageCategoryNamed: ref category.
	self selectedMessageName: ref methodSymbol.
	]! !

!Browser methodsFor: '*services-base' stamp: 'rr 8/5/2005 10:03'!
methodReference 
	| cls sel |
	cls := self selectedClassOrMetaClass.
	sel := self selectedMessageName.
	cls isNil | sel isNil ifTrue: [^nil].
	^ MethodReference class: cls selector: sel! !

!Browser methodsFor: '*services-base' stamp: 'rr 8/19/2005 14:38'!
optionalButtonRow
	^ Preferences useServicesInBrowserButtonBar 
			ifTrue: [ServiceGui browserButtonRow: self]
			ifFalse: [super optionalButtonRow]! !

!Browser methodsFor: '*services-base' stamp: 'rr 8/3/2005 17:16'!
selectReference: ref
	self browseReference: ref! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

Browser class
	instanceVariableNames: ''!

!Browser class methodsFor: 'class initialization' stamp: 'hpt 8/5/2004 19:41'!
initialize
	"Browser initialize"

	RecentClasses := OrderedCollection new.
	! !

!Browser class methodsFor: 'class initialization' stamp: 'hpt 8/5/2004 19:41'!
registerInAppRegistry
	"Register the receiver in the SystemBrowser AppRegistry"
	SystemBrowser register: self.! !

!Browser class methodsFor: 'class initialization' stamp: 'asm 4/10/2003 12:32'!
registerInFlapsRegistry
	"Register the receiver in the system's flaps registry"
	self environment
		at: #Flaps
		ifPresent: [:cl | cl registerQuad: #(#Browser #prototypicalToolWindow 'Browser' 'A Browser is a tool that allows you to view all the code of all the classes in the system' ) 
						forFlapNamed: 'Tools']! !

!Browser class methodsFor: 'class initialization' stamp: 'hpt 8/5/2004 19:42'!
unload
	"Unload the receiver from global registries"

	self environment at: #Flaps ifPresent: [:cl |
	cl unregisterQuadsWithReceiver: self].
	SystemBrowser unregister: self.! !


!Browser class methodsFor: 'instance creation' stamp: 'sd 11/20/2005 21:27'!
fullOnClass: aClass 
	"Open a new full browser set to class."
	| brow |
	brow := self new.
	brow setClass: aClass selector: nil.
	^ self 
		openBrowserView: (brow openEditString: nil)
		label: 'System Browser'! !

!Browser class methodsFor: 'instance creation' stamp: 'sd 11/20/2005 21:28'!
fullOnClass: aClass selector: aSelector
	"Open a new full browser set to class."

	| brow classToUse |
	classToUse := SystemBrowser default.
	brow := classToUse new.
	brow setClass: aClass selector: aSelector.
	^ classToUse 
		openBrowserView: (brow openEditString: nil)
		label: brow labelString! !

!Browser class methodsFor: 'instance creation' stamp: 'di 10/18/1999 22:03'!
new

	^super new systemOrganizer: SystemOrganization! !

!Browser class methodsFor: 'instance creation' stamp: 'sd 11/20/2005 21:28'!
newOnCategory: aCategory
	"Browse the system category of the given name.  7/13/96 sw"

	"Browser newOnCategory: 'Interface-Browser'"

	| newBrowser catList |
	newBrowser := self new.
	catList := newBrowser systemCategoryList.
	newBrowser systemCategoryListIndex: 
		(catList indexOf: aCategory asSymbol ifAbsent: [^ self inform: 'No such category']).
	^ self 
		openBrowserView: (newBrowser openSystemCatEditString: nil)
		label: 'Classes in category ', aCategory
! !

!Browser class methodsFor: 'instance creation' stamp: 'tk 4/18/1998 16:28'!
newOnClass: aClass 
	"Open a new class browser on this class."
	^ self newOnClass: aClass label: 'Class Browser: ', aClass name! !

!Browser class methodsFor: 'instance creation' stamp: 'sd 11/20/2005 21:28'!
newOnClass: aClass label: aLabel
	"Open a new class browser on this class."
	| newBrowser |

	newBrowser := self new.
	newBrowser setClass: aClass selector: nil.
	^ self 
		openBrowserView: (newBrowser openOnClassWithEditString: nil)
		label: aLabel
! !

!Browser class methodsFor: 'instance creation' stamp: 'sd 11/20/2005 21:28'!
newOnClass: aClass selector: aSymbol
	"Open a new class browser on this class."
	| newBrowser |

	newBrowser := self new.
	newBrowser setClass: aClass selector: aSymbol.
	^ self 
		openBrowserView: (newBrowser openOnClassWithEditString: nil)
		label: 'Class Browser: ', aClass name
! !

!Browser class methodsFor: 'instance creation' stamp: 'md 3/10/2006 21:46'!
open
	^self openBrowser

! !

!Browser class methodsFor: 'instance creation' stamp: 'jcg 10/29/2003 23:11'!
openBrowser
	"Create and schedule a BrowserView with default browser label. The
	view consists of five subviews, starting with the list view of system
	categories of SystemOrganization. The initial text view part is empty."

	| br |
	br := self new.
	^ self
		openBrowserView: (br openEditString: nil)
		label: br defaultBrowserTitle.

! !

!Browser class methodsFor: 'instance creation' stamp: 'sps 3/9/2004 15:54'!
openBrowserView: aBrowserView label: aString 
	"Schedule aBrowserView, labelling the view aString."

	aBrowserView isMorph
		ifTrue:  [(aBrowserView setLabel: aString) openInWorld]
		ifFalse: [aBrowserView label: aString.
				aBrowserView minimumSize: 300 @ 200.
				aBrowserView subViews do: [:each | each controller].
				aBrowserView controller open].

	^ aBrowserView model
! !

!Browser class methodsFor: 'instance creation' stamp: 'sd 11/20/2005 21:28'!
openMessageBrowserForClass: aBehavior selector: aSymbol editString: aString
	"Create and schedule a message browser for the class, aBehavior, in 
	which the argument, aString, contains characters to be edited in the text 
	view. These characters are the source code for the message selector 
	aSymbol."

	| newBrowser |
	(newBrowser := self new) setClass: aBehavior selector: aSymbol.
	^ self openBrowserView: (newBrowser openMessageEditString: aString)
		label: newBrowser selectedClassOrMetaClassName , ' ' , newBrowser selectedMessageName
! !

!Browser class methodsFor: 'instance creation' stamp: 'sd 11/20/2005 21:28'!
prototypicalToolWindow
	"Answer an example of myself seen in a tool window, for the benefit of parts-launching tools"

	| aWindow |
	aWindow := self new openAsMorphEditing: nil.
	aWindow setLabel: 'System Browser'; applyModelExtent.
	^ aWindow! !

!Browser class methodsFor: 'instance creation' stamp: 'nk 6/2/2004 12:55'!
systemOrganizer: anOrganizer

	^(super new)
		systemOrganizer: anOrganizer;
		yourself! !


!Browser class methodsFor: 'window color' stamp: 'sw 2/26/2002 13:46'!
windowColorSpecification
	"Answer a WindowColorSpec object that declares my preference"

	^ WindowColorSpec classSymbol: self name  wording: 'Browser' brightColor: #lightGreen pastelColor: #paleGreen helpMessage: 'The standard "system browser" tool that allows you to browse through all the code in the system'! !

Browser initialize!