[Pkg] The Trunk: Tools-ar.160.mcz

commits at source.squeak.org commits at source.squeak.org
Mon Jan 4 01:56:03 UTC 2010


Andreas Raab uploaded a new version of Tools to project The Trunk:
http://source.squeak.org/trunk/Tools-ar.160.mcz

==================== Summary ====================

Name: Tools-ar.160
Author: ar
Time: 4 January 2010, 2:55:19 am
UUID: 29ed4916-cd43-aa43-ae17-a6c2155926c0
Ancestors: Tools-ar.159

Make Protocols unloadable: Move ProtocolBrowser, Lexicon, InstanceBrowser to Protocols-Tools. Remove support for change set categories since they introduced another protocol dependency. If you care about the latter, holler and I'll put them back.

=============== Diff against Tools-ar.159 ===============

Item was changed:
  ----- Method: ChangeSorter>>changeSetList (in category 'changeSet menu') -----
  changeSetList
  	"Answer a list of ChangeSet names to be shown in the change sorter."
  
+ 	^ChangeSet allChangeSets collect:[:cs| cs name]!
- 	^ self changeSetCategory changeSetList!

Item was changed:
  ----- Method: ChangeSorter>>shiftedChangeSetMenu: (in category 'changeSet menu') -----
  shiftedChangeSetMenu: aMenu
  	"Set up aMenu to hold items relating to the change-set-list pane when the shift key is down"
  
  	Smalltalk isMorphic ifTrue:
  		[aMenu title: 'Change set (shifted)'.
  		aMenu addStayUpItemSpecial].
  
  	"CONFLICTS SECTION"
  	aMenu add: 'conflicts with other change sets' action: #browseMethodConflicts.
  	aMenu balloonTextForLastItem: 
  'Browse all methods that occur both in this change set and in at least one other change set.'.
  	parent ifNotNil:
  		[aMenu add: 'conflicts with change set opposite' action: #methodConflictsWithOtherSide.
  			aMenu balloonTextForLastItem: 
+ 'Browse all methods that occur both in this change set and in the one on the opposite side of the change sorter.'.].
- 'Browse all methods that occur both in this change set and in the one on the opposite side of the change sorter.'.
- 
- 			aMenu add: 'conflicts with category opposite' action: #methodConflictsWithOppositeCategory.
- 			aMenu balloonTextForLastItem: 
- 'Browse all methods that occur both in this change set and in ANY change set in the category list on the opposite side of this change sorter, other of course than this change set itself.  (Caution -- this could be VERY slow)'].
  	aMenu addLine.
  
  	"CHECKS SECTION"
  	aMenu add: 'check for slips' action: #lookForSlips.
  	aMenu balloonTextForLastItem: 
  'Check this change set for halts and references to Transcript.'.
  
  	aMenu add: 'check for unsent messages' action: #checkForUnsentMessages.
  	aMenu balloonTextForLastItem:
  'Check this change set for messages that are not sent anywhere in the system'.
  
  	aMenu add: 'check for uncommented methods' action: #checkForUncommentedMethods.
  	aMenu balloonTextForLastItem:
  'Check this change set for methods that do not have comments'.
  
  	aMenu add: 'check for uncommented classes' action: #checkForUncommentedClasses.
  	aMenu balloonTextForLastItem:
  'Check for classes with code in this changeset which lack class comments'.
  
  	Utilities authorInitialsPerSe isEmptyOrNil ifFalse:
  		[aMenu add: 'check for other authors' action: #checkForAlienAuthorship.
  		aMenu balloonTextForLastItem:
  'Check this change set for methods whose current authoring stamp does not start with "', Utilities authorInitials, '"'.
  
  	aMenu add: 'check for any other authors' action: #checkForAnyAlienAuthorship.
  	aMenu balloonTextForLastItem:
  'Check this change set for methods any of whose authoring stamps do not start with "', Utilities authorInitials, '"'].
  
  	aMenu add: 'check for uncategorized methods' action: #checkForUnclassifiedMethods.
  	aMenu balloonTextForLastItem:
  'Check to see if any methods in the selected change set have not yet been assigned to a category.  If any are found, open a browser on them.'.
  	aMenu addLine.
  
  	aMenu add: 'inspect change set' action: #inspectChangeSet.
  	aMenu balloonTextForLastItem: 
  'Open an inspector on this change set. (There are some details in a change set which you don''t see in a change sorter.)'.
  
  	aMenu add: 'update' action: #update.
  	aMenu balloonTextForLastItem: 
  'Update the display for this change set.  (This is done automatically when you activate this window, so is seldom needed.)'.
  
  	aMenu add: 'go to change set''s project' action: #goToChangeSetsProject.
  	aMenu balloonTextForLastItem: 
  'If this change set is currently associated with a Project, go to that project right now.'.
  
  	aMenu add: 'promote to top of list' action: #promoteToTopChangeSet.
  	aMenu balloonTextForLastItem:
  'Make this change set appear first in change-set lists in all change sorters.'.
  
  	aMenu add: 'trim history' action: #trimHistory.
  	aMenu balloonTextForLastItem: 
  ' Drops any methods added and then removed, as well as renaming and reorganization of newly-added classes.  NOTE: can cause confusion if later filed in over an earlier version of these changes'.
  
  	aMenu add: 'remove contained in class categories...' action: #removeContainedInClassCategories.
  	aMenu balloonTextForLastItem: ' Drops any changes in given class categories'.
  
  	aMenu add: 'clear this change set' action: #clearChangeSet.
  	aMenu balloonTextForLastItem: 
  'Reset this change set to a pristine state where it holds no information. CAUTION: this is destructive and irreversible!!'.
  	aMenu add: 'expunge uniclasses' action: #expungeUniclasses.
  	aMenu balloonTextForLastItem:
  'Remove from the change set all memory of uniclasses, e.g. classes added on behalf of etoys, fabrik, etc., whose classnames end with a digit.'.
  
  	aMenu add: 'uninstall this change set' action: #uninstallChangeSet.
  	aMenu balloonTextForLastItem: 
  'Attempt to uninstall this change set. CAUTION: this may not work completely and is irreversible!!'.
  
  	aMenu addLine.
  	aMenu add: 'file into new...' action: #fileIntoNewChangeSet.
  	aMenu balloonTextForLastItem: 
  'Load a fileout from disk and place its changes into a new change set (seldom needed -- much better to do this from a file-list browser these days.)'.
  
  	aMenu add: 'reorder all change sets' action: #reorderChangeSets.
  	aMenu balloonTextForLastItem:
  'Applies a standard reordering of all change-sets in the system -- at the bottom will come the sets that come with the release; next will come all the numbered updates; finally, at the top, will come all other change sets'.
  
  	aMenu addLine.
  
  	aMenu add: 'more...' action: #offerUnshiftedChangeSetMenu.
  	aMenu balloonTextForLastItem: 
  'Takes you back to the primary change-set menu.'.
  
  	^ aMenu!

Item was changed:
  ----- Method: ChangeSorter>>updateIfNecessary (in category 'changeSet menu') -----
  updateIfNecessary
  	"Recompute all of my panes."
  
  	| newList |
  	self okToChange ifFalse: [^ self].
  
  	myChangeSet ifNil: [^ self].  "Has been known to happen though shouldn't"
+ 	(myChangeSet isMoribund) ifTrue:
- 	(myChangeSet isMoribund or: [(changeSetCategory notNil and: [changeSetCategory includesChangeSet: myChangeSet]) not]) ifTrue:
  		[self changed: #changeSetList.
+ 		^ self showChangeSet: ChangeSet current].
- 		^ self showChangeSet: self changeSetCategory defaultChangeSetToShow].
  
  	newList := self changeSetList.
  
  	(priorChangeSetList == nil or: [priorChangeSetList ~= newList])
  		ifTrue:
  			[priorChangeSetList := newList.
  			self changed: #changeSetList].
  	self showChangeSet: myChangeSet!

Item was changed:
  SystemOrganization addCategory: #'Tools-ArchiveViewer'!
  SystemOrganization addCategory: #'Tools-Base'!
  SystemOrganization addCategory: #'Tools-Browser'!
  SystemOrganization addCategory: #'Tools-Browser-Tests'!
  SystemOrganization addCategory: #'Tools-Changes'!
  SystemOrganization addCategory: #'Tools-Debugger'!
  SystemOrganization addCategory: #'Tools-Debugger-Tests'!
  SystemOrganization addCategory: #'Tools-Explorer'!
  SystemOrganization addCategory: #'Tools-File Contents Browser'!
  SystemOrganization addCategory: #'Tools-FileList'!
  SystemOrganization addCategory: #'Tools-FileList-Tests'!
  SystemOrganization addCategory: #'Tools-Inspector'!
  SystemOrganization addCategory: #'Tools-Process Browser'!
- SystemOrganization addCategory: #'Tools-Protocols'!

Item was changed:
  CodeHolder subclass: #ChangeSorter
+ 	instanceVariableNames: 'parent myChangeSet currentClassName currentSelector priorChangeSetList'
- 	instanceVariableNames: 'parent myChangeSet currentClassName currentSelector priorChangeSetList changeSetCategory'
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'Tools-Changes'!
  
  !ChangeSorter commentStamp: '<historical>' prior: 0!
  I display a ChangeSet.  Two of me are in a DualChangeSorter.!

Item was changed:
  ----- Method: ChangeSorter>>newSet (in category 'changeSet menu') -----
  newSet
  	"Create a new changeSet and show it., making it the current one.  Reject name if already in use."
  
  	| aSet |
  	self okToChange ifFalse: [^ self].
  	aSet := self class newChangeSet.
+ 	aSet ifNotNil:[
- 	aSet ifNotNil:
- 		[self changeSetCategory acceptsManualAdditions ifTrue:
- 			[changeSetCategory addChangeSet: aSet].
  		self update.
+ 		self showChangeSet: aSet.
- 		(changeSetCategory includesChangeSet: aSet) ifTrue:
- 			[self showChangeSet: aSet].
  		self changed: #relabel]!

Item was changed:
  Object subclass: #ChangesOrganizer
  	instanceVariableNames: ''
+ 	classVariableNames: 'ChangeSetNamesInRelease RecentUpdateMarker'
- 	classVariableNames: 'ChangeSetCategories ChangeSetNamesInRelease RecentUpdateMarker'
  	poolDictionaries: ''
  	category: 'Tools-Changes'!
  
  !ChangesOrganizer commentStamp: 'pk 10/17/2006 09:25' prior: 0!
  Changes organizer!

Item was changed:
  ----- Method: ChangeSorter>>changeSetListKey:from: (in category 'changeSet menu') -----
  changeSetListKey: aChar from: view
  	"Respond to a Command key.  I am a model with a listView that has a list of changeSets."
  
  	aChar == $b ifTrue: [^ self browseChangeSet].
  	aChar == $B ifTrue: [^ self openChangeSetBrowser].
  	aChar == $c ifTrue: [^ self copyAllToOther].
  	aChar == $D ifTrue: [^ self toggleDiffing]. 
  	aChar == $f ifTrue: [^ self findCngSet].
  	aChar == $m ifTrue: [^ self newCurrent].
  	aChar == $n ifTrue: [^ self newSet].
  	aChar == $o ifTrue: [^ self fileOut].
  	aChar == $p ifTrue: [^ self addPreamble].
  	aChar == $r ifTrue: [^ self rename].
- 	aChar == $s ifTrue: [^ self chooseChangeSetCategory].
  	aChar == $x ifTrue: [^ self remove].
  	aChar == $- ifTrue: [^ self subtractOtherSide].
  
  	^ self messageListKey: aChar from: view!

Item was changed:
  ----- Method: DualChangeSorter>>labelString (in category 'other') -----
  labelString
  	"The window label"
+ 	^'Changes go to "', ChangeSet current name,  '"'.!
- 
- 	| leftName rightName changesName |
- 	leftName := leftCngSorter changeSetCategory categoryName.
- 	rightName := rightCngSorter changeSetCategory categoryName.
- 	changesName := 'Changes go to "', ChangeSet current name,  '"'.
- 	^ ((leftName ~~ #All) or: [rightName ~~ #All])
- 		ifTrue:
- 			['(', leftName, ') - ', changesName, ' - (', rightName, ')']
- 		ifFalse:
- 			[changesName]!

Item was changed:
  ----- Method: ChangeSorter>>labelString (in category 'access') -----
  labelString
  	"The label for my entire window.  The large button that displays my name is gotten via mainButtonName"
  
  	^ String streamContents:
  		[:aStream |
  			aStream nextPutAll: (ChangeSet current == myChangeSet
  				ifTrue: ['Changes go to "', myChangeSet name, '"']
+ 				ifFalse: ['ChangeSet: ', myChangeSet name])]!
- 				ifFalse: ['ChangeSet: ', myChangeSet name]).
- 		(self changeSetCategory categoryName ~~ #All)
- 			ifTrue:
- 				[aStream nextPutAll:  ' - ', self parenthesizedCategoryName]]!

Item was changed:
  ----- Method: ChangeSorter>>changeSetMenu:shifted: (in category 'changeSet menu') -----
  changeSetMenu: aMenu shifted: isShifted 
  	"Set up aMenu to hold commands for the change-set-list pane.  This could be for a single or double changeSorter"
  
  	isShifted ifTrue: [^ self shiftedChangeSetMenu: aMenu].
  	Smalltalk isMorphic
  		ifTrue:
  			[aMenu title: 'Change Set'.
  			aMenu addStayUpItemSpecial]
  		ifFalse:
  			[aMenu title: 'Change Set:
  ' , myChangeSet name].
  
  	aMenu add: 'make changes go to me (m)' action: #newCurrent.
  	aMenu addLine.
  	aMenu add: 'new change set... (n)' action: #newSet.
  	aMenu add: 'find...(f)' action: #findCngSet.
- 	aMenu add: 'show category... (s)' action:  #chooseChangeSetCategory.
- 	aMenu balloonTextForLastItem:
- 'Lets you choose which change sets should be listed in this change sorter'.
  	aMenu add: 'select change set...' action: #chooseCngSet.
  	aMenu addLine.
  	aMenu add: 'rename change set (r)' action: #rename.
  	aMenu add: 'file out (o)' action: #fileOut.
  	aMenu add: 'mail to list' action: #mailOut.
  	aMenu add: 'browse methods (b)' action: #browseChangeSet.
  	aMenu add: 'browse change set (B)' action: #openChangeSetBrowser.
  	aMenu addLine.
  	parent
  		ifNotNil: 
  			[aMenu add: 'copy all to other side (c)' action: #copyAllToOther.
  			aMenu add: 'submerge into other side' action: #submergeIntoOtherSide.
  			aMenu add: 'subtract other side (-)' action: #subtractOtherSide.
  			aMenu addLine].
  	myChangeSet hasPreamble
  		ifTrue: 
  			[aMenu add: 'edit preamble (p)' action: #addPreamble.
  			aMenu add: 'remove preamble' action: #removePreamble]
  		ifFalse: [aMenu add: 'add preamble (p)' action: #addPreamble].
  	myChangeSet hasPostscript
  		ifTrue: 
  			[aMenu add: 'edit postscript...' action: #editPostscript.
  			aMenu add: 'remove postscript' action: #removePostscript]
  		ifFalse: [aMenu add: 'add postscript...' action: #editPostscript].
  	aMenu addLine.
  
- 	aMenu add: 'category functions...' action: #offerCategorySubmenu.
- 	aMenu balloonTextForLastItem:
- 'Various commands relating to change-set-categories'.
- 	aMenu addLine.
- 
- 
  	aMenu add: 'destroy change set (x)' action: #remove.
  	aMenu addLine.
  	aMenu add: 'more...' action: #offerShiftedChangeSetMenu.
  	^ aMenu!

Item was changed:
  ----- Method: ChangeSorter>>veryDeepInner: (in category 'creation') -----
  veryDeepInner: deepCopier
  	"Copy all of my instance variables.  Some need to be not copied at all, but shared."
  
  super veryDeepInner: deepCopier.
  "parent := parent.		Weakly copied"
  "myChangeSet := myChangeSet.		Weakly copied"
  currentClassName := currentClassName veryDeepCopyWith: deepCopier.
  "currentSelector := currentSelector.		Symbol"
  priorChangeSetList := priorChangeSetList veryDeepCopyWith: deepCopier.
+ 
- changeSetCategory := changeSetCategory.
  
  !

Item was changed:
  ----- Method: ChangesOrganizer class>>initialize (in category 'class initialization') -----
  initialize
  
  	"Initialize the class variables"
- 	ChangeSetCategories ifNil:
- 		[self initializeChangeSetCategories].
  	RecentUpdateMarker := 0.
  
  
  !

Item was removed:
- ----- Method: StaticChangeSetCategory>>includesChangeSet: (in category 'queries') -----
- includesChangeSet: aChangeSet
- 	"Answer whether the receiver includes aChangeSet in its retrieval list"
- 
- 	^ elementDictionary includesKey: aChangeSet name!

Item was removed:
- ----- Method: Lexicon>>obtainNewSearchString (in category 'search') -----
- obtainNewSearchString
- 	"Put up a box allowing the user to enter a fresh search string"
- 
- 	| fragment |
- 	
- 	fragment := UIManager default request: 'type method name or fragment: ' initialAnswer: self currentQueryParameter.
- 	fragment ifNil: [^ self].
- 	(fragment := fragment copyWithout: $ ) size == 0  ifTrue: [^ self].
- 	currentQueryParameter := fragment.
- 	fragment := fragment asLowercase.
- 	currentQuery := #selectorName.
- 	self showQueryResultsCategory.
- 	self messageListIndex: 0!

Item was removed:
- ----- Method: Lexicon>>okayToAccept (in category 'model glue') -----
- okayToAccept
- 	"Answer whether it is okay to accept the receiver's input"
- 
- 	| ok aClass reply |
- 	(ok := super okayToAccept) ifTrue:
- 		[((aClass := self selectedClassOrMetaClass) ~~ targetClass) ifTrue:
- 			[reply := UIManager default chooseFrom: 
- 	{'okay, no problem'. 
- 	'cancel - let me reconsider'. 
- 	'compile into ', targetClass name, ' instead'.
- 	'compile into a new uniclass'} title:
- 'Caution!!  This would be
- accepted into class ', aClass name, '.
- Is that okay?' .
- 			reply = 1 ifTrue: [^ true].
- 			reply ~~ 2 ifTrue:
- 				[self notYetImplemented].
- 			^ false]].
- 	^ ok!

Item was removed:
- ----- Method: Lexicon>>categoryWithNameSpecifiedBy: (in category 'category list') -----
- categoryWithNameSpecifiedBy: aSelector
- 	"Answer the category name obtained by sending aSelector to my class.  This provides a way to avoid hard-coding the wording of conventions such as '-- all --'"
- 
- 	^ self class perform: aSelector!

Item was removed:
- ----- Method: StaticChangeSetCategory>>reconstituteList (in category 'updating') -----
- reconstituteList
- 	"Reformulate the list.  Here, since we have a manually-maintained list, at this juncture we only make sure change-set-names are still up to date, and we purge moribund elements"
- 
- 	|  survivors |
- 	survivors := elementDictionary select: [:aChangeSet | aChangeSet isMoribund not].
- 	self clear.
- 	(survivors asSortedCollection: [:a :b | a name <= b name]) reverseDo:
- 		[:aChangeSet | self addChangeSet: aChangeSet]!

Item was removed:
- ----- Method: Lexicon>>categoryDefiningSelector: (in category 'category list') -----
- categoryDefiningSelector: aSelector
- 	"Answer a category in which aSelector occurs"
- 
- 	| categoryNames |
- 	categoryNames := categoryList copyWithoutAll: #('-- all --').
- 	^ currentVocabulary categoryWithNameIn: categoryNames thatIncludesSelector: aSelector forInstance: self targetObject ofClass: targetClass!

Item was removed:
- ----- Method: ChangeSorter>>offerCategorySubmenu (in category 'changeSet menu') -----
- offerCategorySubmenu
- 	"Offer a menu of category-related items"
- 
- 	self offerMenuFrom: #categorySubmenu:shifted: shifted: false!

Item was removed:
- ----- Method: Lexicon>>annotation (in category 'basic operation') -----
- annotation
- 	"Provide a line of annotation material for a middle pane."
- 
- 	| aCategoryName |
- 	self selectedMessageName ifNotNil: [^ super annotation].
- 	(aCategoryName := self selectedCategoryName) ifNil:
- 		[^ self hasSearchPane
- 			ifTrue:
- 				['type a message name or fragment in the top pane and hit RETURN or ENTER']
- 			ifFalse:
- 				[''  "currentVocabulary documentation"]].
- 
- 
- 	(aCategoryName = self class queryCategoryName) ifTrue:
- 		[^ self queryCharacterization].
- 		
- 	#(
- 	(allCategoryName			'Shows all methods, whatever other category they belong to')
- 	(viewedCategoryName		'Methods visited recently.  Use  "-" button to remove a method from this category.')
- 	(queryCategoryName		'Query results'))
- 
- 		do:
- 			[:pair | (self categoryWithNameSpecifiedBy: pair first) = aCategoryName ifTrue: [^ pair second]].
- 
- 	^ currentVocabulary categoryCommentFor: aCategoryName!

Item was removed:
- ----- Method: Lexicon>>lastSendersSearchSelector (in category 'search') -----
- lastSendersSearchSelector
- 	"Answer the last senders search selector, initializing it to a default value if it does not already have a value"
- 
- 	^ currentQueryParameter ifNil: [currentQueryParameter := #flag:]!

Item was removed:
- ----- Method: ProtocolBrowser>>list (in category 'accessing') -----
- list
- 	"Answer the receiver's message list."
- 	^ messageList!

Item was removed:
- ----- Method: Lexicon>>selectedCategoryName (in category 'category list') -----
- selectedCategoryName
- 	"Answer the selected category name"
- 
- 	^ categoryList ifNotNil:
- 		[categoryList at: categoryListIndex ifAbsent: [nil]]!

Item was removed:
- ----- Method: ChangeSetCategoryWithParameters>>includesChangeSet: (in category 'as yet unclassified') -----
- includesChangeSet: aChangeSet
- 	"Answer whether the receiver includes aChangeSet in its retrieval list"
- 
- 	^ ChangesOrganizer perform: membershipSelector withArguments: { aChangeSet } , parameters!

Item was removed:
- ----- Method: ProtocolBrowser>>selectedClassOrMetaClass (in category 'class list') -----
- selectedClassOrMetaClass
- 	^selectedClass!

Item was removed:
- ----- Method: ChangeSorter>>renameCategory (in category 'changeSet menu') -----
- renameCategory
- 	"Obtain a new name for the category and, if acceptable, apply it"
- 
- 	| catName oldName |
- 	self changeSetCategory acceptsManualAdditions ifFalse:
- 		[^ self inform: 'sorry, you can only rename manually-added categories.'].
- 
- 	catName := UIManager default request: 'Please give the new category a name' initialAnswer:  (oldName := changeSetCategory categoryName).
- 	catName isEmptyOrNil ifTrue: [^ self].
- 	(catName := catName asSymbol) = oldName ifTrue: [^ self inform: 'no change.'].
- 	(self changeSetCategories includesKey: catName) ifTrue:
- 		[^ self inform: 'Sorry, there is already a category of that name'].
- 
- 	changeSetCategory categoryName: catName.
- 	self changeSetCategories removeElementAt: oldName.
- 	self changeSetCategories elementAt: catName put: changeSetCategory.
- 
- 	self update!

Item was removed:
- ----- Method: Lexicon>>setLocalClassVarRefs (in category 'within-tool queries') -----
- setLocalClassVarRefs
- 	"Put up a list of the class variables in the viewed object, and when the user selects one, let the query results category show all the references to that class variable."
- 
- 	| aName |
- 
- 	(aName := targetClass theNonMetaClass chooseClassVarName) ifNil: [^ self].
- 	currentQuery := #classVarRefs.
- 	currentQueryParameter := aName.
- 	self showQueryResultsCategory!

Item was removed:
- ----- Method: Lexicon>>canShowMultipleMessageCategories (in category 'message category functions') -----
- canShowMultipleMessageCategories
- 	"Answer whether the receiver is capable of showing multiple message categories"
- 
- 	^ true!

Item was removed:
- ----- Method: ChangeSorter>>fileOutAllChangeSets (in category 'changeSet menu') -----
- fileOutAllChangeSets
- 	"File out all nonempty change sets in the current category, probably"
- 
- 	self changeSetCategory fileOutAllChangeSets!

Item was removed:
- ----- Method: Lexicon>>navigateToNextMethod (in category 'history') -----
- navigateToNextMethod
- 	"Navigate to the 'next' method in the current viewing sequence"
- 
- 	| anIndex aSelector |
- 	self selectorsVisited size == 0 ifTrue: [^ self].
- 	anIndex := (aSelector := self selectedMessageName) notNil ifTrue: [selectorsVisited indexOf: aSelector ifAbsent: [selectorsVisited size]] ifFalse: [1].
- 	self selectedCategoryName == self class viewedCategoryName 
- 		ifTrue:
- 			[self selectWithinCurrentCategory: (selectorsVisited atWrap: (anIndex + 1))]
- 		ifFalse:
- 			[self displaySelector: (selectorsVisited atWrap: (anIndex + 1))]!

Item was removed:
- ----- Method: Lexicon>>preserveSelectorIfPossibleSurrounding: (in category 'transition') -----
- preserveSelectorIfPossibleSurrounding: aBlock
- 	"Make a note of the currently-selected method; perform aBlock and then attempt to reestablish that same method as the selected one in the new circumstances"
- 
- 	| aClass aSelector |
- 	aClass := self selectedClassOrMetaClass.
- 	aSelector := self selectedMessageName.
- 	aBlock value.
- 	
- 	self hasSearchPane
- 		ifTrue:
- 			[self setMethodListFromSearchString]
- 		ifFalse:
- 			[self maybeReselectClass: aClass selector: aSelector]!

Item was removed:
- ----- Method: CodeHolder>>spawnFullProtocol (in category 'commands') -----
- spawnFullProtocol
- 	"Create and schedule a new protocol browser on the currently selected class or meta."
- 
- 	| aClassOrMetaclass |
- 	(aClassOrMetaclass := self selectedClassOrMetaClass) ifNotNil:
-        	[ProtocolBrowser openFullProtocolForClass: aClassOrMetaclass]!

Item was removed:
- ----- Method: InstanceBrowser>>offerMenu (in category 'menu commands') -----
- offerMenu
- 	"Offer a menu to the user, in response to the hitting of the menu button on the tool pane"
- 
- 	| aMenu |
- 	aMenu := MenuMorph new defaultTarget: self.
- 	aMenu title: 'Messages of ', objectViewed nameForViewer.
- 	aMenu addStayUpItem.
- 	aMenu addList: #(
- 		('vocabulary...' 			chooseVocabulary)
- 		('what to show...'			offerWhatToShowMenu)
- 		-
- 		('inst var refs (here)'		setLocalInstVarRefs)
- 		('inst var defs (here)'		setLocalInstVarDefs)
- 		('class var refs (here)'		setLocalClassVarRefs)
- 		-
- 
- 		('navigate to a sender...' 	navigateToASender)
- 		('recent...' 					navigateToRecentMethod)
- 		('show methods in current change set'
- 									showMethodsInCurrentChangeSet)
- 		('show methods with initials...'
- 									showMethodsWithInitials)
- 		-
- 		"('toggle search pane' 		toggleSearch)"
- 
- 		-
- 		-
- 		('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)
- 		('versions (v)' 				browseVersions)
- 		('inheritance (i)'			methodHierarchy)
- 		-
- 		('inst var refs' 				browseInstVarRefs)
- 		('inst var defs' 				browseInstVarDefs)
- 		('class var refs' 			browseClassVarRefs)
- 		-
- 		('viewer on me'				viewViewee)
- 		('inspector on me'			inspectViewee)
- 		-
- 		('more...'					shiftedYellowButtonActivity)).
- 
- 	aMenu popUpInWorld: ActiveWorld!

Item was removed:
- ----- Method: Lexicon>>reformulateListNoting: (in category 'transition') -----
- reformulateListNoting: newSelector
- 	"A method has possibly been submitted for the receiver with newSelector as its selector; If the receiver has a way of reformulating its message list, here is a chance for it to do so"
- 
- 	super reformulateListNoting: newSelector.
- 	newSelector ifNotNil:
- 		[self displaySelector: newSelector]!

Item was removed:
- ----- Method: Lexicon class>>sendersCategoryName (in category 'visible category names') -----
- sendersCategoryName
- 	"Answer the name to be used for the senders-results category"
- 
- 	true ifTrue: [^ #'-- "senders" results --'].
- 
- 	^ '-- "senders" results --'.  "so methods-strings-containing will find this"!

Item was removed:
- ----- Method: Lexicon>>seeAlso: (in category 'within-tool queries') -----
- seeAlso: aSelector
- 	"If the requested selector is showable in the current browser, show it here, minding unsubmitted edits however"
- 
- 	((currentVocabulary includesSelector: aSelector forInstance: self targetObject ofClass: targetClass limitClass: limitClass)   "i.e., is aSelector available in this browser"
- 					and: [self okToChange])
- 		ifTrue:
- 			[self displaySelector: aSelector]
- 		ifFalse:
- 			[Beeper beep]!

Item was removed:
- ----- Method: Lexicon>>selectorsSendingSelectedSelector (in category 'senders') -----
- selectorsSendingSelectedSelector
- 	"Assumes lastSendersSearchSelector is already set"
- 	| selectorSet |
- 	autoSelectString := (self lastSendersSearchSelector upTo: $:) asString.
- 	selectorSet := Set new.
- 	(self systemNavigation allCallsOn: self lastSendersSearchSelector)
- 		do: [:anItem | | sel cl | 
- 			sel := anItem methodSymbol.
- 			cl := anItem actualClass.
- 			((currentVocabulary
- 						includesSelector: sel
- 						forInstance: self targetObject
- 						ofClass: targetClass
- 						limitClass: limitClass)
- 					and: [targetClass includesBehavior: cl])
- 				ifTrue: [selectorSet add: sel]].
- 	^ selectorSet asSortedArray!

Item was removed:
- ----- Method: ProtocolBrowser class>>openSubProtocolForClass: (in category 'instance creation') -----
- openSubProtocolForClass: aClass 
- 	"Create and schedule a browser for the entire protocol of the class."
- 	"ProtocolBrowser openSubProtocolForClass: ProtocolBrowser."
- 	| aPBrowser label |
- 	aPBrowser := ProtocolBrowser new onSubProtocolOf: aClass.
- 	label := 'Sub-protocol of: ', aClass name.
- 	self open: aPBrowser name: label!

Item was removed:
- ----- Method: Lexicon>>limitClass (in category 'limit class') -----
- limitClass
- 	"Answer the most generic class to show in the browser.  By default, we go all the way up to ProtoObject"
- 
- 	^ limitClass ifNil: [self initialLimitClass]!

Item was removed:
- ----- Method: Lexicon>>messageListKey:from: (in category 'message list menu') -----
- messageListKey: aChar from: view
- 	"Respond to a Command key"
- 
- 	aChar == $f ifTrue: [^ self obtainNewSearchString].
- 	^ super messageListKey: aChar from: view!

Item was removed:
- ----- Method: ChangeSorter>>removeCategory (in category 'changeSet menu') -----
- removeCategory
- 	"Remove the current category"
- 
- 	| itsName |
- 	self changeSetCategory acceptsManualAdditions ifFalse:
- 		[^ self inform: 'sorry, you can only remove manually-added categories.'].
- 
- 	(self confirm: 'Really remove the change-set-category
- named ', (itsName := changeSetCategory categoryName), '?') ifFalse: [^ self].
- 
- 	self changeSetCategories removeElementAt: itsName.
- 	self setDefaultChangeSetCategory.
- 
- 	self update!

Item was removed:
- ----- Method: ChangeSetCategory>>membershipSelector: (in category 'initialization') -----
- membershipSelector: aSelector
- 	"Set the membershipSelector"
- 
- 	membershipSelector := aSelector!

Item was removed:
- ----- Method: Lexicon>>contents (in category 'contents') -----
- contents
- 	"We have a class, allow new messages to be defined"
- 
- 	editSelection == #newMessage ifTrue: [^ targetClass sourceCodeTemplate].
- 	^ super contents!

Item was removed:
- ----- Method: Lexicon>>messageListIndex: (in category 'basic operation') -----
- messageListIndex: anIndex
- 	"Set the message list index as indicated, and update the history list if appropriate"
- 
- 	| newSelector current |
- 	current := self selectedMessageName.
- 	super messageListIndex: anIndex.
- 	anIndex = 0 ifTrue: [
- 		self editSelection: #newMessage.
- 		self contentsChanged].
- 	(newSelector := self selectedMessageName) ifNotNil: 
- 		[self updateSelectorsVisitedfrom: current to: newSelector]!

Item was removed:
- ----- Method: ChangeSorter>>showCategoriesOfChangeSet (in category 'changeSet menu') -----
- showCategoriesOfChangeSet
- 	"Show a list of all the categories in which the selected change-set occurs at the moment.  Install the one the user chooses, if any."
- 
- 	| aMenu |
- 	Smalltalk isMorphic
- 		ifFalse:
- 			[self inform:
- 'Only available in morphic, right now, sorry.
- It would not take much to make this
- also work in mvc, so if you are
- inclined to do that, thanks in advance...']
- 		ifTrue:
- 			[aMenu := MenuMorph new defaultTarget: self.
- 	aMenu title: 
- 'Categories which
- contain change set
- "', myChangeSet name, '"'.
- 			self changeSetCategories elementsInOrder do:
- 				[:aCategory |
- 					(aCategory includesChangeSet: myChangeSet)
- 						ifTrue:
- 							[aMenu add: aCategory categoryName target: self selector: #showChangeSetCategory: argument: aCategory.
- 						aCategory == changeSetCategory ifTrue:
- 							[aMenu lastItem color: Color red]].
- 						aMenu balloonTextForLastItem: aCategory documentation].
- 				aMenu popUpInWorld]!

Item was removed:
- ----- Method: Lexicon>>selectorsMatching (in category 'search') -----
- selectorsMatching
- 	"Anwer a list of selectors in the receiver that match the current search string"
- 
- 	| fragment aList |
- 	fragment := self lastSearchString asLowercase.
- 	aList := targetClass allSelectors select:
- 		[:aSelector | (aSelector includesSubstring: fragment caseSensitive: false) and:
- 			[currentVocabulary includesSelector: aSelector forInstance: self targetObject ofClass: targetClass limitClass: limitClass]].
- 
- 	^ aList asSortedArray!

Item was removed:
- ----- Method: ChangeSorter>>categorySubmenu:shifted: (in category 'changeSet menu') -----
- categorySubmenu: aMenu  shifted: shiftedIgnored
- 	"Fill aMenu with less-frequently-needed category items"
- 	
- 	aMenu title: 'Change set category'.
- 	aMenu addStayUpItem.
- 
- 	aMenu addList: #(
- 		('make a new category...' makeNewCategory 'Creates a new change-set-category (you will be asked to supply a name) which will start out its life with this change set in it')
- 		('make a new category with class...' makeNewCategoryShowingClassChanges 'Creates a new change-set-category that includes change sets that change a particular class (you will be asked to supply a name)')
- 		('rename this category' renameCategory 'Rename this change-set category.   Only applies when the current category being shown is a manually-maintained, user-defined category, such as you can create for yourself by choosing "make a new category..." from this same menu.')
- 		('remove this category' removeCategory 'Remove this change-set category.   Only applies when the current category being shown is a manually-maintained, user-defined category, such as you can create for yourself by choosing "make a new category..." from this same menu.')
- 		('show categories of this changeset' showCategoriesOfChangeSet 'Show a list of all the change-set categories that contain this change-set; if the you choose one of the categories from this pop-up, that category will be installed in this change sorter')
- 	-).
- 
- 	parent ifNotNil:
- 		[aMenu addList: #(
- 			('add change set to category opposite' addToCategoryOpposite 'Adds this change set to the category on the other side of the change sorter.  Only applies if the category shown on the opposite side is a manually-maintained, user-defined category, such as you can create for yourself by choosing "make a new category..." from this same menu.'))].
- 
- 	aMenu addList: #(
- 		('remove change set from this category' removeFromCategory 'Removes this change set from the current category.  Only applies when the current category being shown is a manually-maintained, user-defined category, such as you can create for yourself by choosing "make a new category..." from this same menu.')
- 		-
- 		('file out category''s change sets' fileOutAllChangeSets 'File out every change set in this category that has anything in it.  The usual checks for slips are suppressed when this command is done.')
- 		('set recent-updates marker' setRecentUpdatesMarker 'Allows you to specify a number that will demarcate which updates are considered "recent" and which are not.  This will govern which updates are included in the RecentUpdates category in a change sorter')
- 		('fill aggregate change set' fillAggregateChangeSet 'Creates a change-set named Aggregate into which all the changes in all the change sets in this category will be copied.')
- 		-
- 		('back to main menu' offerUnshiftedChangeSetMenu 'Takes you back to the shifted change-set menu.')
- 		('back to shifted menu' offerShiftedChangeSetMenu 'Takes you back to the primary change-set menu.')).
- 
- 	^ aMenu!

Item was removed:
- ----- Method: Lexicon>>selectWithinCurrentCategoryIfPossible: (in category 'category list') -----
- selectWithinCurrentCategoryIfPossible: aSelector
- 	"If the receiver's message list contains aSelector, navigate right to it without changing categories"
-  
- 	| detectedItem messageIndex |
- 	aSelector ifNil: [^ self].
- 	detectedItem := messageList detect:
- 		[:anItem | (anItem asString upTo: $ ) asSymbol == aSelector] ifNone: [^ self].
- 	messageIndex := messageList indexOf: detectedItem.
- 	self messageListIndex: messageIndex
- !

Item was removed:
- ----- Method: Lexicon>>methodsWithInitials: (in category 'within-tool queries') -----
- methodsWithInitials: initials
- 	"Return a list of selectors representing methods whose timestamps have the given initials and which are in the protocol of this object and within the range dictated by my limitClass."
- 
- 	| classToUse |
- 	classToUse := self targetObject ifNotNil: [self targetObject class] ifNil: [targetClass].  "In support of lightweight uniclasses"
- 	^ targetClass allSelectors select:
- 		[:aSelector | (currentVocabulary includesSelector: aSelector forInstance: self targetObject ofClass: classToUse limitClass: limitClass) and:
- 			[Utilities doesMethod: aSelector forClass: classToUse bearInitials: initials]].
- 
- !

Item was removed:
- ----- Method: Lexicon>>categoryList (in category 'category list') -----
- categoryList
- 	"Answer the category list for the protcol, creating it if necessary, and prepending the -- all -- category, and appending the other special categories for search results, etc."
- 
- 	| specialCategoryNames |
- 	categoryList ifNil:
- 		[specialCategoryNames := #(queryCategoryName  viewedCategoryName "searchCategoryName sendersCategoryName  changedCategoryName activeCategoryName")  collect:
- 			[:sym | self class perform: sym].
- 		categoryList :=
- 			(currentVocabulary categoryListForInstance: self targetObject ofClass: targetClass limitClass: limitClass),
- 			specialCategoryNames,
- 			(Array with: self class allCategoryName)].
- 	^ categoryList!

Item was removed:
- ----- Method: Lexicon>>setSendersSearch (in category 'senders') -----
- setSendersSearch
- 	"Put up a list of messages sent in the current message, find all methods 
- 	of the browsee which send the one the user chooses, and show that list 
- 	in the message-list pane, with the 'query results' item selected in the 
- 	category-list pane"
- 	| selectorSet aSelector aString |
- 	self selectedMessageName
- 		ifNil: [aString := UIManager default request: 'Type selector to search for' initialAnswer: 'flag:'.
- 			aString isEmptyOrNil
- 				ifTrue: [^ self].
- 			Symbol
- 				hasInterned: aString
- 				ifTrue: [:sel | aSelector := sel]]
- 		ifNotNil: [self
- 				selectMessageAndEvaluate: [:sel | aSelector := sel]].
- 	aSelector
- 		ifNil: [^ self].
- 	selectorSet := Set new.
- 	(self systemNavigation allCallsOn: aSelector)
- 		do: [:anItem | selectorSet add: anItem methodSymbol].
- 	selectorSet := selectorSet
- 				select: [:sel | currentVocabulary
- 						includesSelector: sel
- 						forInstance: self targetObject
- 						ofClass: targetClass
- 						limitClass: limitClass].
- 	selectorSet size > 0
- 		ifTrue: [currentQuery := #senders.
- 			currentQueryParameter := aSelector.
- 			self
- 				categoryListIndex: (categoryList indexOf: self class queryCategoryName).
- 			self messageListIndex: 0]!

Item was removed:
- ----- Method: Lexicon>>offerMenu (in category 'menu commands') -----
- offerMenu
- 	"Offer a menu to the user, in response to the hitting of the menu button on the tool pane"
- 
- 	| aMenu |
- 	aMenu := MenuMorph new defaultTarget: self.
- 	aMenu addTitle: 'Lexicon'.
- 	aMenu addStayUpItem.
- 	aMenu addList: #(
- 
- 		('vocabulary...' 			chooseVocabulary)
- 		('what to show...'			offerWhatToShowMenu)
- 		-
- 		('inst var refs (here)'		setLocalInstVarRefs)
- 		('inst var defs (here)'		setLocalInstVarDefs)
- 		('class var refs (here)'		setLocalClassVarRefs)
- 		-
- 
- 		('navigate to a sender...' 	navigateToASender)
- 		('recent...' 					navigateToRecentMethod)
- 		('show methods in current change set'
- 									showMethodsInCurrentChangeSet)
- 		('show methods with initials...'
- 									showMethodsWithInitials)
- 		-
- 		"('toggle search pane' 		toggleSearch)"
- 
- 		-
- 		('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)
- 		('versions (v)' 				browseVersions)
- 		('inheritance (i)'			methodHierarchy)
- 		-
- 		('inst var refs' 				browseInstVarRefs)
- 		('inst var defs' 				browseInstVarDefs)
- 		('class var refs' 			browseClassVarRefs)
- 		-
- 		('more...'					shiftedYellowButtonActivity)).
- 
- 	aMenu popUpInWorld: ActiveWorld!

Item was removed:
- ----- Method: Lexicon>>addModelItemsToWindowMenu: (in category 'window title') -----
- addModelItemsToWindowMenu: aMenu
- 	"Add model-related item to the window menu"
- 
- 	super addModelItemsToWindowMenu: aMenu. 
- 	aMenu add: 'choose vocabulary...' target: self action: #chooseVocabulary!

Item was removed:
- ----- Method: Lexicon>>addSpecialButtonsTo:with: (in category 'toolbuilder') -----
- addSpecialButtonsTo: buttonPanelSpec with: builder
- 
- 	| homeCatBtnSpec menuBtnSpec mostGenericBtnSpec |
- 	homeCatBtnSpec := builder pluggableButtonSpec new
- 		model: self;
- 		action: #showHomeCategory;
- 		label: (ScriptingSystem formAtKey: #Cat) asMorph;
- 		help: 'show this method''s home category';
- 		yourself.
- 	menuBtnSpec := builder pluggableButtonSpec new
- 		model: self;
- 		action: #offerMenu;
- 		label: (ScriptingSystem formAtKey: #TinyMenu) asMorph;
- 		help: 'click here to get a menu with further options';
- 		yourself.
- 	mostGenericBtnSpec :=builder pluggableButtonSpec new
- 		model: self;
- 		action: #chooseLimitClass;
- 		label: #limitClassString;
- 		help: 'Governs which classes'' methods should be shown.  If this is the same as the viewed class, then only methods implemented in that class will be shown.  If it is ProtoObject, then methods of all classes in the vocabulary will be shown.'.
- 	buttonPanelSpec children
- 		add: homeCatBtnSpec;
- 		addFirst: mostGenericBtnSpec;
- 		addFirst: menuBtnSpec.!

Item was removed:
- ----- Method: Lexicon>>lastSearchString: (in category 'search') -----
- lastSearchString: aString
- 	"Make a note of the last string searched for in the receiver"
- 
- 	currentQueryParameter := aString asString.
- 	currentQuery := #selectorName.
- 	autoSelectString := aString.
- 	self setMethodListFromSearchString.
- 	^ true!

Item was removed:
- ----- Method: ProtocolBrowser>>growable (in category 'accessing') -----
- growable
- 	"Answer whether the receiver is subject to manual additions and deletions"
- 
- 	^ false!

Item was removed:
- ----- Method: Lexicon>>selectorsReferringToClassVar (in category 'category list') -----
- selectorsReferringToClassVar
- 	"Return a list of methods that refer to given class var that are in the 
- 	protocol of this object"
- 	| aList aClass nonMeta poolAssoc |
- 	nonMeta := targetClass theNonMetaClass.
- 	aClass := nonMeta classThatDefinesClassVariable: currentQueryParameter.
- 	aList := OrderedCollection new.
- 	poolAssoc := aClass classPool associationAt: currentQueryParameter asSymbol.
- 	(self systemNavigation allCallsOn: poolAssoc)
- 		do: [:elem | (nonMeta isKindOf: elem actualClass)
- 				ifTrue: [aList add: elem methodSymbol]].
- 	^ aList!

Item was removed:
- ----- Method: ChangeSetCategory>>acceptsManualAdditions (in category 'queries') -----
- acceptsManualAdditions
- 	"Answer whether the user is allowed manually to manipulate the contents of the change-set-category."
- 
- 	^ false!

Item was removed:
- ----- Method: Lexicon>>categoryListMenuTitle (in category 'category list') -----
- categoryListMenuTitle
- 	"Answer the menu title for the category list menu"
- 
- 	^ 'categories'!

Item was removed:
- ----- Method: Lexicon>>categoryOfSelector: (in category 'selection') -----
- categoryOfSelector: aSelector 
- 	"Answer the name of the defining category for aSelector, or nil if none"
- 	| classDefiningSelector |
- 	classDefiningSelector := targetClass whichClassIncludesSelector: aSelector.
- 	classDefiningSelector
- 		ifNil: [^ nil].
- 	"can happen for example if one issues this from a change-sorter for a 
- 	message that is recorded as having been removed"
- 	^ classDefiningSelector whichCategoryIncludesSelector: aSelector!

Item was removed:
- ----- Method: Lexicon>>buildCustomButtonsWith: (in category 'toolbuilder') -----
- buildCustomButtonsWith: builder
- 
- 	"This method if very similar to StringHolder>>buildOptionalButtonsWith:.
- 	Refactor and pass in button specs?"
- 	| panelSpec |
- 	panelSpec := builder pluggablePanelSpec new.
- 	panelSpec children: OrderedCollection new.
- 	self customButtonSpecs do: [:spec | | buttonSpec |
- 		buttonSpec := builder pluggableActionButtonSpec new.
- 		buttonSpec model: self.
- 		buttonSpec label: spec first.
- 		buttonSpec action: spec second.
- 		spec size > 2 ifTrue: [buttonSpec help: spec third].
- 		panelSpec children add: buttonSpec.
- 	].
- 	panelSpec layout: #horizontal. "buttons"
- 	self addSpecialButtonsTo: panelSpec with: builder.
- 	^panelSpec!

Item was removed:
- ----- Method: ProtocolBrowser>>selector (in category 'accessing') -----
- selector
- 	"Answer the receiver's selected selector."
- 	^ selectedSelector!

Item was removed:
- ----- Method: ChangeSorter>>fillAggregateChangeSet (in category 'changeSet menu') -----
- fillAggregateChangeSet
- 	"Create a change-set named Aggregate and pour into it all the changes in all the change-sets of the currently-selected category"
- 
- 	self changeSetCategory fillAggregateChangeSet!

Item was removed:
- ----- Method: StaticChangeSetCategory>>addChangeSet: (in category 'add') -----
- addChangeSet: aChangeSet
- 	"Add the change set manually"
- 
- 	self elementAt: aChangeSet name put: aChangeSet!

Item was removed:
- ----- Method: Lexicon>>showSearchPane (in category 'search') -----
- showSearchPane
- 	"Given that the receiver is showing the categories pane, replace that with a search pane.  Though there is a residual UI for obtaining this variant, it is obscure and the integrity of the protocol-category-browser when there is no categories pane is not necessarily assured at the moment."
- 
- 	| aPane |
- 	(aPane := self categoriesPane) ifNil: [^ Beeper beep].
- 	self containingWindow replacePane: aPane with: self newSearchPane.
- 	categoryList := nil.
- 	self changed: #categoryList.
- 	self changed: #messageList!

Item was removed:
- ----- Method: Lexicon>>queryCharacterization (in category 'within-tool queries') -----
- queryCharacterization
- 	"Answer a characterization of the most recent query"
- 
- 	currentQuery == #selectorName
- 		ifTrue: [^ 'My methods whose names include "', self lastSearchString, '"'].
- 	currentQuery == #methodsWithInitials
- 		ifTrue: [^ 'My methods stamped with initials ', currentQueryParameter].
- 	currentQuery == #senders
- 		ifTrue: [^ 'My methods that send #', self lastSendersSearchSelector].
- 	currentQuery == #currentChangeSet
- 		ifTrue: [^ 'My methods in the current change set'].
- 	currentQuery == #instVarRefs
- 		ifTrue:	[^ 'My methods that refer to instance variable "', currentQueryParameter, '"'].
- 	currentQuery == #instVarDefs
- 		ifTrue:	[^ 'My methods that store into instance variable "', currentQueryParameter, '"'].
- 	currentQuery == #classVarRefs
- 		ifTrue:	[^ 'My methods that refer to class variable "', currentQueryParameter, '"'].
- 	^ 'Results of queries will show up here'!

Item was removed:
- ----- Method: Lexicon>>selectorsDefiningInstVar (in category 'within-tool queries') -----
- selectorsDefiningInstVar
- 	"Return a list of methods that define a given inst var that are in the protocol of this object"
- 
- 	| aList  |
- 	aList := OrderedCollection new.
- 	targetClass withAllSuperclassesDo:
- 		[:aClass | 
- 			(aClass whichSelectorsStoreInto: currentQueryParameter asString) do: 
- 				[:sel | sel isDoIt ifFalse: [aList add: sel]
- 			]
- 		].
- 	^ aList!

Item was removed:
- ----- Method: ProtocolBrowser>>setClassAndSelectorIn: (in category 'private') -----
- setClassAndSelectorIn: csBlock
- 	"Decode strings of the form    <selectorName> (<className> [class])"
- 
- 	| i classAndSelString selString sel |
- 
- 	sel := self selection ifNil: [^ csBlock value: nil value: nil].
- 	(sel isKindOf: MethodReference) ifTrue: [
- 		sel setClassAndSelectorIn: csBlock
- 	] ifFalse: [
- 		selString := sel asString.
- 		i := selString indexOf: $(.
- 		"Rearrange to  <className> [class] <selectorName> , and use MessageSet"
- 		classAndSelString := (selString copyFrom: i + 1 to: selString size - 1) , ' ' ,
- 							(selString copyFrom: 1 to: i - 1) withoutTrailingBlanks.
- 		MessageSet parse: classAndSelString toClassAndSelector: csBlock.
- 	].
- !

Item was removed:
- ----- Method: Lexicon>>setToShowSelector: (in category 'selection') -----
- setToShowSelector: aSelector
- 	"Set up the receiver so that it will show the given selector"
- 
- 	| catName catIndex detectedItem messageIndex aList |
- 	catName := (aList := currentVocabulary categoriesContaining: aSelector  forClass: targetClass) size > 0
- 		ifTrue:
- 			[aList first]
- 		ifFalse:
- 			[self class allCategoryName].
- 	catIndex := categoryList indexOf: catName ifAbsent: [1].
- 	self categoryListIndex: catIndex.
- 	detectedItem := messageList detect:
- 		[:anItem | (anItem upTo: $ ) asString asSymbol == aSelector] ifNone: [^ self].
- 	messageIndex := messageList indexOf: detectedItem.
- 	self messageListIndex: messageIndex
- !

Item was removed:
- ----- Method: ChangesOrganizer class>>initializeChangeSetCategories (in category 'class initialization') -----
- initializeChangeSetCategories
- 	"Initialize the set of change-set categories"
- 	"ChangeSorter initializeChangeSetCategories"
- 
- 	| aCategory |
- 	ChangeSetCategories := ElementCategory new categoryName: #ChangeSetCategories.
- 
- 	aCategory := ChangeSetCategory new categoryName: #All.
- 	aCategory membershipSelector: #belongsInAll:.
- 	aCategory documentation: 'All change sets known to the system'.
- 	ChangeSetCategories addCategoryItem: aCategory.
- 
- 	aCategory := ChangeSetCategory new categoryName: #Additions.
- 	aCategory membershipSelector: #belongsInAdditions:.
- 	aCategory documentation: 'All unnumbered change sets except those representing projects in the system as initially released.'.
- 	ChangeSetCategories addCategoryItem: aCategory.
- 
- 	aCategory := ChangeSetCategory new categoryName: #MyInitials.
- 	aCategory membershipSelector: #belongsInMyInitials:.
- 	aCategory documentation: 'All change sets whose names end with the current author''s initials.'.
- 	ChangeSetCategories addCategoryItem: aCategory.
- 
- 	aCategory := ChangeSetCategory new categoryName: #Numbered.
- 	aCategory membershipSelector: #belongsInNumbered:.
- 	aCategory documentation: 'All change sets whose names start with a digit -- normally these will be the official updates to the system.'.
- 	ChangeSetCategories addCategoryItem: aCategory.
- 
- 	aCategory := ChangeSetCategory new categoryName: #ProjectChangeSets.
- 	aCategory membershipSelector: #belongsInProjectChangeSets:.
- 	aCategory documentation: 'All change sets that are currently associated with projects present in the system right now.'.
- 	ChangeSetCategories addCategoryItem: aCategory.
- 
- 	aCategory := ChangeSetCategory new categoryName: #ProjectsInRelease.
- 	aCategory membershipSelector: #belongsInProjectsInRelease:.
- 	aCategory documentation: 'All change sets belonging to projects that were shipped in the initial release of this version of Squeak'.
- 	ChangeSetCategories addCategoryItem: aCategory.
- 
- 	aCategory := ChangeSetCategory new categoryName: #RecentUpdates.
- 	aCategory membershipSelector: #belongsInRecentUpdates:.
- 	aCategory documentation: 'Updates whose numbers are at or beyond the number I have designated as the earliest one to qualify as Recent'.
- 	ChangeSetCategories addCategoryItem: aCategory.
- 
- 	ChangeSetCategories elementsInOrder do: [:anElem | anElem reconstituteList] !

Item was removed:
- ----- Method: Lexicon>>switchToVocabulary: (in category 'vocabulary') -----
- switchToVocabulary: aVocabulary
- 	"Make aVocabulary be the current one in the receiver"
- 
- 	self preserveSelectorIfPossibleSurrounding:
- 		[self useVocabulary: aVocabulary.
- 		self reformulateCategoryList.
- 		self adjustWindowTitle]
- !

Item was removed:
- ----- Method: Lexicon>>selectorsVisited (in category 'history') -----
- selectorsVisited
- 	"Answer the list of selectors visited in this tool"
- 
- 	^ selectorsVisited ifNil: [selectorsVisited := OrderedCollection new]!

Item was removed:
- ----- Method: Inspector>>spawnProtocol (in category 'menu commands') -----
- spawnProtocol
- 	"Spawn a protocol on browser on the receiver's selection"
- 
- 	| objectToRepresent |
- 	objectToRepresent := self selectionIndex == 0 ifTrue: [object] ifFalse: [self selection].
- 	ProtocolBrowser openSubProtocolForClass: objectToRepresent class!

Item was removed:
- ----- Method: ChangeSetCategoryWithParameters>>addChangeSet: (in category 'as yet unclassified') -----
- addChangeSet: aChangeSet
- 	self inform: 'sorry, you can''t do that'!

Item was removed:
- ----- Method: ChangeSorter>>changeSetCategory (in category 'access') -----
- changeSetCategory
- 	"Answer the current changeSetCategory object that governs which change sets are shown in this ChangeSorter"
- 
- 	^ changeSetCategory ifNil:
- 		[self setDefaultChangeSetCategory]!

Item was removed:
- ----- Method: ChangeSorter>>makeNewCategoryShowingClassChanges (in category 'changeSet menu') -----
- makeNewCategoryShowingClassChanges
- 	"Create a new, static change-set category, which will be populated entirely by change sets that have been manually placed in it"
- 
- 	| catName aCategory clsName |
- 	clsName := self selectedClass ifNotNil: [self selectedClass name ] ifNil: [''].
- 	clsName := UIManager default request: 'Which class?' initialAnswer: clsName.
- 	clsName isEmptyOrNil ifTrue: [^ self].
- 	catName := ('Changes to ', clsName) asSymbol.
- 	(self changeSetCategories includesKey: catName) ifTrue:
- 		[^ self inform: 'Sorry, there is already a category of that name'].
- 
- 	aCategory := ChangeSetCategoryWithParameters new categoryName: catName.
- 	aCategory membershipSelector: #changeSet:containsClass: ; parameters: { clsName }.
- 	self changeSetCategories elementAt: catName put: aCategory.
- 	aCategory reconstituteList.
- 	self showChangeSetCategory: aCategory!

Item was removed:
- ----- Method: ProtocolBrowser class>>openFullProtocolForClass: (in category 'instance creation') -----
- openFullProtocolForClass: aClass 
- 	"Create and schedule a browser for the entire protocol of the class."
- 	"ProtocolBrowser openFullProtocolForClass: ProtocolBrowser."
- 	| aPBrowser label |
- 	aPBrowser := ProtocolBrowser new on: aClass.
- 	label := 'Entire protocol of: ', aClass name.
- 	self open: aPBrowser name: label!

Item was removed:
- ----- Method: Lexicon>>setMethodListFromSearchString (in category 'search') -----
- setMethodListFromSearchString
- 	"Set the method list of the receiver based on matches from the search string"
- 
- 	| fragment aList |
- 	self okToChange ifFalse: [^ self].
- 	fragment := currentQueryParameter.
- 	fragment := fragment asString asLowercase withBlanksTrimmed.
- 
- 	aList := targetClass allSelectors select:
- 		[:aSelector | currentVocabulary includesSelector: aSelector forInstance: self targetObject ofClass: targetClass limitClass: limitClass].
- 	fragment size > 0 ifTrue:
- 		[aList := aList select:
- 			[:aSelector | aSelector includesSubstring: fragment caseSensitive: false]].
- 	aList size == 0 ifTrue:
- 		[^ Beeper beep].
- 	self initListFrom: aList asSortedArray highlighting: targetClass.
- 	messageListIndex :=  messageListIndex min: messageList size.
- 	self changed: #messageList
- !

Item was removed:
- ----- Method: InstanceBrowser>>openOnObject:showingSelector: (in category 'initialization') -----
- openOnObject: anObject showingSelector: aSelector
- 	"Create and open a SystemWindow to house the receiver, showing the categories pane."
- 
- 	objectViewed := anObject.
- 	self openOnClass: anObject class showingSelector: aSelector!

Item was removed:
- ----- Method: ProtocolBrowser>>selector: (in category 'accessing') -----
- selector: aString
- 	"Set the currently selected message selector to be aString."
- 	selectedSelector := aString.
- 	self changed: #selector!

Item was removed:
- ----- Method: ChangeSetCategory>>reconstituteList (in category 'miscellaneous') -----
- reconstituteList
- 	"Clear out the receiver's elements and rebuild them"
- 
- 	| newMembers |
- 	"First determine newMembers and check if they have not changed..."
- 	newMembers := ChangesOrganizer allChangeSets select:
- 		[:aChangeSet | ChangesOrganizer perform: membershipSelector with: aChangeSet].
- 	(newMembers collect: [:cs | cs name]) = keysInOrder ifTrue: [^ self  "all current"].
- 
- 	"Things have changed.  Need to recompute the whole category"
- 	self clear.
- 	newMembers do:
- 		[:aChangeSet | self fasterElementAt: aChangeSet name asSymbol put: aChangeSet] 
- !

Item was removed:
- ----- Method: Lexicon>>reformulateList (in category 'transition') -----
- reformulateList
- 	"Make the category list afresh, and reselect the current selector if appropriate"
- 
- 	self preserveSelectorIfPossibleSurrounding:
- 		[super reformulateList.
- 		self categoryListIndex: categoryListIndex]!

Item was removed:
- ----- Method: Lexicon>>setLimitClass: (in category 'limit class') -----
- setLimitClass: aClass
- 	"Set aClass as the limit class for this browser"
- 
- 	| currentClass currentSelector |
- 	currentClass := self selectedClassOrMetaClass.
- 	currentSelector := self selectedMessageName.
- 
- 	self limitClass: aClass.
- 	categoryList := nil.
- 	self categoryListIndex: 0.
- 	self changed: #categoryList.
- 	self changed: #methodList.
- 	self changed: #contents.
- 	self changed: #limitClassString.
- 	self adjustWindowTitle.
- 	self hasSearchPane
- 		ifTrue:
- 			[self setMethodListFromSearchString].
- 
- 	self maybeReselectClass: currentClass selector: currentSelector
- 
- 	!

Item was removed:
- ----- Method: Lexicon>>initListFrom:highlighting: (in category 'initialization') -----
- initListFrom: selectorCollection highlighting: aClass 
- 	"Make up the messageList with items from aClass in boldface.  Provide a final filtering in that only selectors whose implementations fall within my limitClass will be shown."
- 
- 	
- 	messageList := OrderedCollection new.
- 	selectorCollection do: 
- 		[:selector | | item defClass |  defClass := aClass whichClassIncludesSelector: selector.
- 		(defClass notNil and: [defClass includesBehavior: self limitClass]) ifTrue:
- 			[item := selector, '     (' , defClass name , ')'.
- 			item := item asText.
- 			defClass == aClass ifTrue: [item allBold].
- 			"(self isThereAnOverrideOf: selector) ifTrue: [item addAttribute: TextEmphasis struckOut]."
- 			"The above has a germ of a good idea but could be very slow"
- 			messageList add: item]]!

Item was removed:
- ----- Method: Lexicon>>navigateToPreviousMethod (in category 'history') -----
- navigateToPreviousMethod
- 	"Navigate to the 'previous' method in the current viewing sequence"
- 
- 	| anIndex aSelector |
- 	self selectorsVisited size == 0 ifTrue: [^ self].
- 	anIndex := (aSelector := self selectedMessageName) notNil
- 		ifTrue: [selectorsVisited indexOf: aSelector ifAbsent: [selectorsVisited size]]
- 		ifFalse: [selectorsVisited size].
- 	self selectedCategoryName == self class viewedCategoryName 
- 		ifTrue:
- 			[self selectWithinCurrentCategory: (selectorsVisited atWrap: (anIndex - 1))]
- 		ifFalse:
- 			[self displaySelector: (selectorsVisited atWrap: (anIndex - 1))]!

Item was removed:
- ----- Method: Lexicon>>displaySelector: (in category 'basic operation') -----
- displaySelector: aSelector
- 	"Set aSelector to be the one whose source shows in the browser.  If there is a category list, make it highlight a suitable category"
- 
- 	| detectedItem messageIndex |
- 	self chooseCategory: (self categoryDefiningSelector: aSelector).
- 	detectedItem := messageList detect:
- 		[:anItem | (anItem asString upTo: $ ) asSymbol == aSelector] ifNone: [^ Beeper beep].
- 	messageIndex := messageList indexOf: detectedItem.
- 	self messageListIndex: messageIndex!

Item was removed:
- ----- Method: ChangeSorter>>methodConflictsWithOppositeCategory (in category 'changeSet menu') -----
- methodConflictsWithOppositeCategory
- 	"Check to see if ANY change set on the other side shares any methods with the selected change set; if so, open a browser on all such."
- 
- 	| aList otherCategory |
- 
- 	otherCategory := (parent other: self) changeSetCategory.
- 	aList := myChangeSet 
- 		messageListForChangesWhich: [ :aClass :aSelector |
- 			aClass notNil and: 
- 				[otherCategory 
- 					hasChangeForClassName: aClass name 
- 					selector: aSelector 
- 					otherThanIn: myChangeSet]
- 		]
- 		ifNone: [^ self inform: 
- 'There are no methods that appear both in
- this change set and in any change set
- (other than this one) on the other side.'].
- 	
- 	MessageSet 
- 		openMessageList: aList 
- 		name: 'Methods in "', myChangeSet name, '" also in some other change set in category ', otherCategory categoryName,' (', aList size printString, ')'
- 	!

Item was removed:
- ----- Method: InstanceBrowser>>targetObject (in category 'target-object access') -----
- targetObject
- 	"Answer the object to which this tool is bound"
- 
- 	^ objectViewed!

Item was removed:
- ----- Method: Lexicon>>setLocalInstVarDefs (in category 'within-tool queries') -----
- setLocalInstVarDefs
- 	"Put up a list of the instance variables in the viewed object, and when the user seletcts one, let the query results category show all the references to that instance variable."
- 
- 	| instVarToProbe |
- 
- 	targetClass chooseInstVarThenDo:
- 		[:aName | instVarToProbe := aName].
- 	instVarToProbe isEmptyOrNil ifTrue: [^ self].
- 	currentQuery := #instVarDefs.
- 	currentQueryParameter := instVarToProbe.
- 	self showQueryResultsCategory!

Item was removed:
- ----- Method: InstanceBrowser>>startingWindowTitle (in category 'window title') -----
- startingWindowTitle
- 	"Answer the initial window title to apply"
- 
- 	^ 'Vocabulary of ', objectViewed nameForViewer!

Item was removed:
- ----- Method: Lexicon>>initialLimitClass (in category 'limit class') -----
- initialLimitClass
- 	"Choose a plausible initial vlaue for the limit class, and answer it"
- 
- 	| oneTooFar |
- 	limitClass := targetClass.
- 	(#('ProtoObject' 'Object' 'Behavior' 'ClassDescription' 'Class' 'ProtoObject class' 'Object class') includes: targetClass name asString) ifTrue: [^ targetClass].
- 
- 	oneTooFar := (targetClass isKindOf: Metaclass)
- 		ifTrue:
- 			["use the fifth back from the superclass chain for Metaclasses, which is the immediate subclass of ProtoObject class.  Print <ProtoObject class allSuperclasses> to count them yourself."
- 			targetClass allSuperclasses at: (targetClass allSuperclasses size - 5)]
- 		ifFalse:
- 			[targetClass allSuperclasses at: targetClass allSuperclasses size].
- 	[limitClass superclass ~~ oneTooFar]
- 		whileTrue: [limitClass := limitClass superclass].
- 	^ limitClass!

Item was removed:
- ----- Method: Lexicon>>categoryListIndex (in category 'category list') -----
- categoryListIndex
- 	"Answer the index of the currently-selected item in in the category list"
- 
- 	^ categoryListIndex ifNil: [categoryListIndex := 1]!

Item was removed:
- ----- Method: ChangeSorter>>showChangeSetCategory: (in category 'changeSet menu') -----
- showChangeSetCategory: aChangeSetCategory
- 	"Show the given change-set category"
- 	
- 	changeSetCategory := aChangeSetCategory.
- 	self changed: #changeSetList.
- 	(self changeSetList includes: myChangeSet name) ifFalse:
- 			[self showChangeSet: (ChangesOrganizer changeSetNamed: self changeSetList first)].
- 	self changed: #relabel!

Item was removed:
- ----- Method: Lexicon>>setClassAndSelectorIn: (in category 'selection') -----
- setClassAndSelectorIn: csBlock
- 	"Decode strings of the form    <selectorName> (<className> [class])"
- 
- 
- 	self selection ifNil: [^ csBlock value: targetClass value: nil].
- 	^ super setClassAndSelectorIn: csBlock!

Item was removed:
- ----- Method: Lexicon>>adjustWindowTitle (in category 'window title') -----
- adjustWindowTitle
- 	"Set the title of the receiver's window, if any, to reflect the current choices"
- 
- 	| aWindow aLabel catName |
- 	(catName := self selectedCategoryName) ifNil: [^ self].
- 	(aWindow := self containingWindow) ifNil: [^ self].
- 	aLabel := nil.
- 	#(	(viewedCategoryName		'Messages already viewed - ')
- 		(allCategoryName			'All messages - ')) do:
- 			[:aPair | catName = (self categoryWithNameSpecifiedBy: aPair first) ifTrue: [aLabel := aPair second]].
- 
- 	aLabel ifNil:
- 		[aLabel := catName = self class queryCategoryName
- 			ifTrue:
- 				[self queryCharacterization, ' - ']
- 			ifFalse:
- 				['Vocabulary of ']].
- 	aWindow setLabel: aLabel, (self targetObject ifNil: [targetClass]) nameForViewer!

Item was removed:
- ----- Method: ProtocolBrowser>>onSubProtocolOf: (in category 'private') -----
- onSubProtocolOf: aClass 
- 	"Initialize with the entire protocol for the class, aClass,
- 		but excluding those inherited from Object."
- 	| selectors |
- 	selectors := Set new.
- 	aClass withAllSuperclasses do:
- 		[:each | (each == Object or: [each == ProtoObject]) 
- 			ifFalse: [selectors addAll: each selectors]].
- 	self initListFrom: selectors asSortedCollection
- 		highlighting: aClass!

Item was removed:
- ----- Method: ChangeSorter>>setDefaultChangeSetCategory (in category 'creation') -----
- setDefaultChangeSetCategory
- 	"Set a default ChangeSetCategory for the receiver, and answer it"
- 
- 	^ changeSetCategory := self class changeSetCategoryNamed: #All!

Item was removed:
- ----- Method: InstanceBrowser>>openOnObject:inWorld:showingSelector: (in category 'initialization') -----
- openOnObject: anObject inWorld: ignored showingSelector: aSelector
- 	"Create and open a SystemWindow to house the receiver, showing the categories pane."
- 	^self openOnObject: anObject showingSelector: aSelector!

Item was removed:
- ----- Method: Lexicon>>categoryListKey:from: (in category 'category list') -----
- categoryListKey: aChar from: aView
- 	"The user hit a command-key while in the category-list.  Do something"
- 
- 	(aChar == $f and: [self hasSearchPane not]) ifTrue:
- 		[^ self obtainNewSearchString].!

Item was removed:
- ChangeSetCategory subclass: #ChangeSetCategoryWithParameters
- 	instanceVariableNames: 'parameters'
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'Tools-Changes'!

Item was removed:
- ----- Method: Lexicon>>lastSearchString (in category 'search') -----
- lastSearchString
- 	"Answer the last search string, initializing it to an empty string if it has not been initialized yet"
- 
- 	^ currentQueryParameter ifNil: [currentQueryParameter := 'contents']!

Item was removed:
- ----- Method: Lexicon class>>viewedCategoryName (in category 'visible category names') -----
- viewedCategoryName
- 	"Answer the name to be used for the previously-viewed-methods category"
- 
- 	true ifTrue: [^ #'-- active --'].
- 
- 	^ '-- active --' asSymbol	 "For benefit of method-strings-containing-it search"
- !

Item was removed:
- ----- Method: Lexicon>>showHomeCategory (in category 'menu commands') -----
- showHomeCategory
- 	"Continue to show the current selector, but show it within the context of its primary category"
- 
- 	| aSelector |
- 	(aSelector := self selectedMessageName) ifNotNil:
- 		[self preserveSelectorIfPossibleSurrounding:
- 			[self setToShowSelector: aSelector]]!

Item was removed:
- ----- Method: Lexicon class>>allCategoryName (in category 'visible category names') -----
- allCategoryName
- 	"Answer the name to be used for the all category"
- 
- 	true ifTrue: [^ #'-- all --'].
- 
- 	'-- all --' asSymbol  "Placed here so a message-strings-containing-it query will find this method"
- !

Item was removed:
- ----- Method: Lexicon>>targetObject (in category 'model glue') -----
- targetObject
- 	"Answer the object to which this tool is bound."
- 
- 	^ nil!

Item was removed:
- ----- Method: Lexicon>>startingWindowTitle (in category 'window title') -----
- startingWindowTitle
- 	"Answer the initial window title to apply"
- 
- 	^ 'Vocabulary of ', targetClass nameForViewer!

Item was removed:
- ----- Method: Lexicon>>browseInstVarRefs (in category 'new-window queries') -----
- browseInstVarRefs
- 	"Let the search pertain to the target class regardless of selection"
- 	self systemNavigation  browseInstVarRefs: targetClass!

Item was removed:
- ----- Method: InstanceBrowser class>>windowColorSpecification (in category 'window color') -----
- windowColorSpecification
- 	"Answer a WindowColorSpec object that declares my preference"
- 
- 	^ WindowColorSpec classSymbol: self name wording: 'Instance Browser' brightColor: #(0.806 1.0 1.0) pastelColor: #(0.925 1.000 1.0) helpMessage: 'A tool for browsing the full protocol of an instance.'!

Item was removed:
- ProtocolBrowser subclass: #Lexicon
- 	instanceVariableNames: 'currentVocabulary categoryList categoryListIndex targetClass limitClass currentQuery currentQueryParameter selectorsVisited'
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'Tools-Protocols'!
- 
- !Lexicon commentStamp: '<historical>' prior: 0!
- An instance of Lexicon shows the a list of all the method categories known to an object or any of its superclasses, as a "flattened" list, and, within any selected category, shows all methods understood by the class's instances which are associated with that category, again as a "flattened" list.  A variant with a search pane rather than a category list is also implemented.
- 
- categoryList				the list of categories
- categoryListIndex		index of currently-selected category
- targetObject				optional -- an instance being viewed
- targetClass				the class being viewed
- lastSearchString			the last string searched for
- lastSendersSearchSelector	the last senders search selector
- limitClass				optional -- the limit class to search for
- selectorsVisited			list of selectors visited
- selectorsActive			not presently in use, subsumed by selectorsVisited
- currentVocabulary		the vocabulary currently installed
- currentQuery			what the query category relates to:
- 							#senders #selectorName #currentChangeSet!

Item was removed:
- ----- Method: Lexicon>>limitClass: (in category 'limit class') -----
- limitClass: aClass
- 	"Set the most generic class to show as indicated"
- 
- 	limitClass := aClass!

Item was removed:
- ----- Method: Inspector>>spawnFullProtocol (in category 'menu commands') -----
- spawnFullProtocol
- 	"Spawn a window showing full protocol for the receiver's selection"
- 
- 	| objectToRepresent |
- 	objectToRepresent := self selectionIndex == 0 ifTrue: [object] ifFalse: [self selection].
- 	ProtocolBrowser openFullProtocolForClass: objectToRepresent class!

Item was removed:
- ----- Method: Lexicon>>showMethodsWithInitials (in category 'within-tool queries') -----
- showMethodsWithInitials
- 	"Prompt the user for initials to scan for; then show, in the query-results category, all methods with those initials in their time stamps"
- 
- 	| initials |
- 	initials := UIManager default request: 'whose initials? ' initialAnswer: Utilities authorInitials.
- 	initials isEmptyOrNil ifTrue: [^ self].
- 	self showMethodsWithInitials: initials
- 
- 
- !

Item was removed:
- ----- Method: Lexicon class>>activeCategoryName (in category 'visible category names') -----
- activeCategoryName
- 	"Answer the name to be used for the active-methods category"
- 
- 	true ifTrue: [^ #'-- current working set --'].
- 
- 	'-- current working set --' asSymbol "Placed here so a message-strings-containing-it query will find this method"
- !

Item was removed:
- ----- Method: Lexicon>>newCategoryPane (in category 'category list') -----
- newCategoryPane
- 	"Formulate a category pane for insertion into the receiver's pane list"
- 
- 	| aListMorph |
- 	aListMorph := PluggableListMorph on: self list: #categoryList
- 			selected: #categoryListIndex changeSelected: #categoryListIndex:
- 			menu: #categoryListMenu:shifted:
- 			keystroke: #categoryListKey:from:.
- 	aListMorph setNameTo: 'categoryList'.
- 	aListMorph menuTitleSelector: #categoryListMenuTitle.
- 	^ aListMorph!

Item was removed:
- ----- Method: StaticChangeSetCategory>>acceptsManualAdditions (in category 'queries') -----
- acceptsManualAdditions
- 	"Answer whether the user is allowed manually to manipulate the contents of the change-set-category."
- 
- 	^ true!

Item was removed:
- ----- Method: ProtocolBrowser>>initListFrom:highlighting: (in category 'private') -----
- initListFrom: selectorCollection highlighting: aClass 
- 	"Make up the messageList with items from aClass in boldface."
- 	messageList := OrderedCollection new.
- 	selectorCollection do: [ :selector |  
- 		| defClass item |
- 		defClass := aClass whichClassIncludesSelector: selector.
- 		item := selector, '     (' , defClass name , ')'.
- 		defClass == aClass ifTrue: [item := item asText allBold].
- 		messageList add: (
- 			MethodReference new
- 				setClass: defClass 
- 				methodSymbol: selector 
- 				stringVersion: item
- 		)
- 	].
- 	selectedClass := aClass.!

Item was removed:
- ----- Method: Lexicon>>browseClassVarRefs (in category 'new-window queries') -----
- browseClassVarRefs
- 	"Let the search pertain to the target class regardless of selection"
- 
- 	self systemNavigation  browseClassVarRefs: targetClass theNonMetaClass !

Item was removed:
- ----- Method: Lexicon>>selectWithinCurrentCategory: (in category 'selection') -----
- selectWithinCurrentCategory: aSelector
- 	"If aSelector is one of the selectors seen in the current category, select it"
- 
- 	| detectedItem |
- 	detectedItem := self messageList detect:
- 		[:anItem | (anItem asString upTo: $ ) asSymbol == aSelector] ifNone: [^ self].
- 	self messageListIndex:  (messageList indexOf: detectedItem ifAbsent: [^ self])!

Item was removed:
- ----- Method: ChangeSetCategoryWithParameters>>parameters: (in category 'as yet unclassified') -----
- parameters: anArray
- 	parameters := anArray!

Item was removed:
- ----- Method: Lexicon>>buildCodePaneWith: (in category 'toolbuilder') -----
- buildCodePaneWith: builder
- 	
- 	| spec standardButtonPanel codePane customPanelSpec |
- 	spec := super buildCodePaneWith: builder.
- 	standardButtonPanel := spec children
- 		detect: [:ea | ea isKindOf:  PluggablePanelSpec]
- 		ifNone: [^ spec]. "do nothing if optionalButtons not enabled"
- 	customPanelSpec := self buildCustomButtonsWith: builder.
- 	customPanelSpec frame: (0 at 0.12 corner: 1 at 0.24).
- 	spec children add: customPanelSpec after: standardButtonPanel.
- 	"resize code pane so that new panel fits in"
- 	codePane := spec children detect: [:ea | ea isKindOf:  PluggableCodePaneSpec].
- 	codePane frame:  (codePane frame withTop: 0.24).
- 	^ spec.!

Item was removed:
- ----- Method: Lexicon>>categoryListMenu:shifted: (in category 'category list') -----
- categoryListMenu: aMenu shifted: aBoolean
- 	"Answer the menu for the category list"
- 
- 	^ aMenu labels: 'find...(f)' lines: #() selections: #(obtainNewSearchString)!

Item was removed:
- ----- Method: ProtocolBrowser>>setSelector: (in category 'accessing') -----
- setSelector: aString
- 	"Set the currently selected message selector to be aString."
- 	selectedSelector := aString!

Item was removed:
- ----- Method: ProtocolBrowser>>getList (in category 'accessing') -----
- getList
- 	"Answer the receiver's message list."
- 	^ messageList!

Item was removed:
- ----- Method: Lexicon>>openOnClass:inWorld:showingSelector: (in category 'toolbuilder') -----
- openOnClass: aTargetClass inWorld: ignored showingSelector: aSelector
- 
- 	^self openOnClass: aTargetClass showingSelector: aSelector!

Item was removed:
- ----- Method: Lexicon>>methodsWithInitials (in category 'within-tool queries') -----
- methodsWithInitials
- 	"Answer the list of method selectors within the scope of this tool whose time stamps begin with the initials designated by my currentQueryParameter"
- 
- 	^ self methodsWithInitials: currentQueryParameter!

Item was removed:
- ----- Method: Lexicon>>setLocalInstVarRefs (in category 'within-tool queries') -----
- setLocalInstVarRefs
- 	"Put up a list of the instance variables in the viewed object, and when the user seletcts one, let the query results category show all the references to that instance variable."
- 
- 	| instVarToProbe |
- 
- 	targetClass chooseInstVarThenDo:
- 		[:aName | instVarToProbe := aName].
- 	instVarToProbe isEmptyOrNil ifTrue: [^ self].
- 	currentQuery := #instVarRefs.
- 	currentQueryParameter := instVarToProbe.
- 	self showQueryResultsCategory!

Item was removed:
- ----- Method: Lexicon>>navigateToASender (in category 'senders') -----
- navigateToASender
- 	"Present the user with a list of senders of the currently-selected 
- 	message, and navigate to the chosen one"
- 	| selectorSet chosen aSelector |
- 	aSelector := self selectedMessageName.
- 	selectorSet := Set new.
- 	(self systemNavigation allCallsOn: aSelector)
- 		do: [:anItem | selectorSet add: anItem methodSymbol].
- 	selectorSet := selectorSet
- 				select: [:sel | currentVocabulary
- 						includesSelector: sel
- 						forInstance: self targetObject
- 						ofClass: targetClass
- 						limitClass: limitClass].
- 	selectorSet size == 0
- 		ifTrue: [^ Beeper beep].
- 	self okToChange
- 		ifFalse: [^ self].
- 	chosen := UIManager default chooseFrom: selectorSet asSortedArray values: selectorSet asSortedArray.
- 	chosen isEmptyOrNil
- 		ifFalse: [self displaySelector: chosen]!

Item was removed:
- ----- Method: Lexicon>>showQueryResultsCategory (in category 'within-tool queries') -----
- showQueryResultsCategory
- 	"Point the receiver at the query-results category and set the search string accordingly"
- 
- 	autoSelectString := self currentQueryParameter.
- 	self categoryListIndex: (categoryList indexOf: self class queryCategoryName).
- 	self messageListIndex: 0!

Item was removed:
- Lexicon subclass: #InstanceBrowser
- 	instanceVariableNames: 'objectViewed'
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'Tools-Protocols'!

Item was removed:
- ----- Method: Lexicon class>>windowColorSpecification (in category 'window color') -----
- windowColorSpecification
- 	"Answer a WindowColorSpec object that declares my preference"
- 
- 	^ WindowColorSpec classSymbol: self name wording: 'Lexicon' brightColor: #(0.878 1.000 0.878) pastelColor: #(0.925 1.000 0.925) helpMessage: 'A tool for browsing the full protocol of a class.'!

Item was removed:
- MessageSet subclass: #ProtocolBrowser
- 	instanceVariableNames: 'selectedClass selectedSelector'
- 	classVariableNames: 'TextMenu'
- 	poolDictionaries: ''
- 	category: 'Tools-Browser'!
- 
- !ProtocolBrowser commentStamp: '<historical>' prior: 0!
- An instance of ProtocolBrowser shows the methods a class understands--inherited or implemented at this level--as a "flattened" list.!

Item was removed:
- ----- Method: ChangeSetCategory>>hasChangeForClassName:selector:otherThanIn: (in category 'queries') -----
- hasChangeForClassName: aClassName selector: aSelector otherThanIn: excludedChangeSet
- 	"Answer whether any change set in this category, other than the excluded one, has a change marked for the given class and selector"
- 
- 	self elementsInOrder do:
- 		[:aChangeSet |
- 			(aChangeSet ~~ excludedChangeSet and:
- 				[((aChangeSet methodChangesAtClass: aClassName) includesKey: aSelector)]) ifTrue:	[^ true]].
- 
- 	^ false!

Item was removed:
- ----- Method: ChangeSorter class>>initializeChangeSetCategories (in category 'deprecated') -----
- initializeChangeSetCategories
- 
- 	^ ChangesOrganizer initializeChangeSetCategories!

Item was removed:
- ----- Method: ChangeSetCategoryWithParameters>>acceptsManualAdditions (in category 'as yet unclassified') -----
- acceptsManualAdditions
- 	"Answer whether the user is allowed manually to manipulate the contents of the change-set-category."
- 
- 	^ true!

Item was removed:
- ----- Method: Lexicon>>navigateToRecentMethod (in category 'history') -----
- navigateToRecentMethod
- 	"Put up a menu of recent selectors visited and navigate to the one chosen"
- 
- 	| visited aSelector |
- 	(visited := self selectorsVisited) size > 1 ifTrue:
- 		[visited := visited copyFrom: 1 to: (visited size min: 20).
- 		aSelector := UIManager default chooseFrom: visited values: visited 
- 			title: 'Recent methods visited in this browser'.
- 		aSelector isEmptyOrNil ifFalse: [self displaySelector: aSelector]]!

Item was removed:
- ----- Method: Lexicon>>methodListFromSearchString: (in category 'search') -----
- methodListFromSearchString: fragment
- 	"Answer a method list of methods whose selectors match the given fragment"
- 
- 	|  aList searchFor |
- 	currentQueryParameter := fragment.
- 	currentQuery := #selectorName.
- 	autoSelectString := fragment.
- 	searchFor := fragment asString asLowercase withBlanksTrimmed.
- 
- 	aList := targetClass allSelectors select:
- 		[:aSelector | currentVocabulary includesSelector: aSelector forInstance: self targetObject ofClass: targetClass limitClass: limitClass].
- 	searchFor size > 0 ifTrue:
- 		[aList := aList select:
- 			[:aSelector | aSelector includesSubstring: searchFor caseSensitive: false]].
- 	^ aList asSortedArray
- !

Item was removed:
- ----- Method: Lexicon>>updateSelectorsVisitedfrom:to: (in category 'history') -----
- updateSelectorsVisitedfrom: oldSelector to: newSelector
- 	"Update the list of selectors visited."
- 
- 	newSelector == oldSelector ifTrue: [^ self].
- 	self selectorsVisited remove: newSelector ifAbsent: [].
- 		
- 	(selectorsVisited includes:  oldSelector)
- 		ifTrue:
- 			[selectorsVisited add: newSelector after: oldSelector]
- 		ifFalse:
- 			[selectorsVisited add: newSelector]
- !

Item was removed:
- ----- Method: Lexicon>>selectedMessage (in category 'selection') -----
- selectedMessage
- 	"Answer the source method for the currently selected message."
- 
- 	(categoryList notNil and: [(categoryListIndex isNil or: [categoryListIndex == 0])])
- 		ifTrue:
- 			[^ '---'].
- 
- 	self setClassAndSelectorIn: [:class :selector | 
- 		class ifNil: [^ 'here would go the documentation for the protocol category, if any.'].
- 
- 		self showingDecompile ifTrue: [^ self decompiledSourceIntoContents].
- 		self showingDocumentation ifTrue: [^ self commentContents].
- 
- 		currentCompiledMethod := class compiledMethodAt: selector ifAbsent: [nil].
- 		^ self sourceStringPrettifiedAndDiffed asText makeSelectorBoldIn: class]!

Item was removed:
- ----- Method: ChangeSetCategory>>changeSetList (in category 'queries') -----
- changeSetList
- 	"Answer the list of change-set names in the category"
- 
- 	| aChangeSet |
- 	self reconstituteList.
- 	keysInOrder size == 0 ifTrue:
- 		["don't tolerate emptiness, because ChangeSorters gag when they have no change-set selected"
- 		aChangeSet := ChangesOrganizer assuredChangeSetNamed: 'New Changes'.
- 		self elementAt: aChangeSet name put: aChangeSet].
- 	^ keysInOrder reversed!

Item was removed:
- ----- Method: Lexicon>>showMethodsWithInitials: (in category 'within-tool queries') -----
- showMethodsWithInitials: initials
- 	"Make the current query be for methods stamped with the given initials"
- 
- 	currentQuery := #methodsWithInitials.
- 	currentQueryParameter := initials.
- 	self showQueryResultsCategory.
- 	autoSelectString := nil.
- 	self changed: #messageList.
- 	self adjustWindowTitle
- !

Item was removed:
- ----- Method: Lexicon>>currentQueryParameter (in category 'within-tool queries') -----
- currentQueryParameter
- 	"Answer the current query parameter"
- 
- 	^ currentQueryParameter ifNil: [currentQueryParameter := 'contents']!

Item was removed:
- ----- Method: Lexicon>>selectorsReferringToInstVar (in category 'within-tool queries') -----
- selectorsReferringToInstVar
- 	"Return a list of methods that refer to a given inst var that are in the protocol of this object"
- 
- 	| aList  |
- 	aList := OrderedCollection new.
- 	targetClass withAllSuperclassesDo: [:aClass | 
- 		(aClass whichSelectorsAccess: currentQueryParameter asString) do: [:sel | 
- 			sel isDoIt ifFalse: [aList add: sel]
- 		]
- 	].
- 	^ aList!

Item was removed:
- ----- Method: ChangeSorter>>chooseChangeSetCategoryInMorphic (in category 'changeSet menu') -----
- chooseChangeSetCategoryInMorphic
- 	"Present the user with a list of change-set-categories and let her choose one.  In this morphic variant, we include balloon help"
- 
- 	|  aMenu |
- 	aMenu := MenuMorph new defaultTarget: self.
- 	aMenu title: 
- 'Choose the category of
- change sets to show in
- this Change Sorter
- (red = current choice)'.
- 	self changeSetCategories elementsInOrder do:
- 		[:aCategory |
- 			aMenu add: aCategory categoryName target: self selector: #showChangeSetCategory: argument: aCategory.
- 			aCategory == changeSetCategory ifTrue:
- 				[aMenu lastItem color: Color red].
- 			aMenu balloonTextForLastItem: aCategory documentation].
- 	aMenu popUpInWorld!

Item was removed:
- ----- Method: ChangeSetCategory>>includesChangeSet: (in category 'queries') -----
- includesChangeSet: aChangeSet
- 	"Answer whether the receiver includes aChangeSet in its retrieval list"
- 
- 	^ ChangesOrganizer perform: membershipSelector with: aChangeSet!

Item was removed:
- ----- Method: Lexicon>>noteAcceptanceOfCodeFor: (in category 'transition') -----
- noteAcceptanceOfCodeFor: newSelector
- 	"The user has submitted new code for the given selector; take a note of it.  NB that the selectors-changed list gets added to here, but is not currently used in the system."
- 
- 	(self selectorsVisited includes: newSelector) ifFalse: [selectorsVisited add: newSelector].!

Item was removed:
- ----- Method: Lexicon>>browseInstVarDefs (in category 'new-window queries') -----
- browseInstVarDefs
- 	"Let the search pertain to the target class regardless of selection"
- 
- 	 self systemNavigation browseInstVarDefs: targetClass!

Item was removed:
- ----- Method: Lexicon>>hasSearchPane (in category 'search') -----
- hasSearchPane
- 	"Answer whether receiver has a search pane"
- 
- 	^ self searchPane notNil!

Item was removed:
- ----- Method: ChangeSorter>>addToCategoryOpposite (in category 'changeSet menu') -----
- addToCategoryOpposite
- 	"Add the current change set to the category viewed on the opposite side, if it's of the sort to accept things like that"
- 
- 	| categoryOpposite |
- 	categoryOpposite := (parent other: self) changeSetCategory.
- 	categoryOpposite acceptsManualAdditions
- 		ifTrue:
- 			[categoryOpposite addChangeSet: myChangeSet.
- 			categoryOpposite reconstituteList.
- 			self update]
- 		ifFalse:
- 			[self inform: 
- 'sorry, this command only makes sense
- if the category showing on the opposite
- side is a static category whose
- members are manually maintained']!

Item was removed:
- ----- Method: ChangeSorter>>removeFromCategory (in category 'changeSet menu') -----
- removeFromCategory
- 	"Add the current change set to the category viewed on the opposite side, if it's of the sort to accept things like that"
- 
- 	| aCategory |
- 	(aCategory := self changeSetCategory) acceptsManualAdditions
- 		ifTrue:
- 			[aCategory removeElementAt: myChangeSet name.
- 			aCategory reconstituteList.
- 			self update]
- 		ifFalse:
- 			[self inform: 
- 'sorry, this command only makes
- sense for static categories whose
- members are manually maintained']!

Item was removed:
- ----- Method: Lexicon>>customButtonSpecs (in category 'control buttons') -----
- customButtonSpecs
- 	"Answer a triplet defining buttons, in the format:
- 
- 			button label
- 			selector to send
- 			help message"
- 	| aa |
- 	aa := contentsSymbol == #tiles ifTrue: [{   "Consult Ted Kaehler regarding this bit"
- 	{'tiles'.				#tilesMenu.					'tiles for assignment and constants'. 	true}.
- 	{'vars'.				#varTilesMenu.	'tiles for instance variables and a new temporary'. 	true}
- 		}] ifFalse: [#()].	"true in 4th place means act on mouseDown"
- 
- 	^ aa, #(
- 	('follow'			seeAlso							'view a method I implement that is called by this method')
- 	('find'				obtainNewSearchString			'find methods by name search')
- 	('sent...'			setSendersSearch				'view the methods I implement that send a given message')
- 
- 	('<'					navigateToPreviousMethod 		'view the previous active method')
- 	('>'					navigateToNextMethod 			'view the next active method')
- 	('-'					removeFromSelectorsVisited		'remove this method from my active list'))!

Item was removed:
- ----- Method: Lexicon>>selectSelectorItsNaturalCategory: (in category 'selection') -----
- selectSelectorItsNaturalCategory: aSelector
- 	"Make aSelector be the current selection of the receiver, with the category being its home category."
- 
- 	| cat catIndex detectedItem |
- 	cat := self categoryOfSelector: aSelector.
- 	catIndex := categoryList indexOf: cat ifAbsent:
- 		["The method's own category is not seen in this browser; the method probably occurs in some other category not known directly to the class, but for now, we'll just use the all category"
- 		1].
- 	self categoryListIndex: catIndex.
- 	detectedItem := messageList detect:
- 		[:anItem | (anItem asString upTo: $ ) asSymbol == aSelector] ifNone: [^ self].
- 	self messageListIndex:  (messageList indexOf: detectedItem ifAbsent: [^ self])!

Item was removed:
- ----- Method: Lexicon>>reformulateCategoryList (in category 'category list') -----
- reformulateCategoryList
- 	"Reformulate the category list"
- 
- 	categoryList := nil.
- 	self categoryListIndex: 0.
- 	self changed: #categoryList.
- 	self contentsChanged!

Item was removed:
- ----- Method: ChangeSorter>>parenthesizedCategoryName (in category 'access') -----
- parenthesizedCategoryName
- 	"Answer my category name in parentheses"
- 
- 	^ ' (', self changeSetCategory categoryName, ')'!

Item was removed:
- ----- Method: Lexicon>>showCategoriesPane (in category 'category list') -----
- showCategoriesPane
- 	"Show the categories pane instead of the search pane"
- 
- 	| aPane |
- 	(aPane := self searchPane) ifNil: [^ Beeper beep].
- 	self containingWindow replacePane: aPane with: self newCategoryPane.
- 	categoryList := nil.
- 	self changed: #categoryList.
- 	self changed: #messageList!

Item was removed:
- ----- Method: Lexicon>>categoryListIndex: (in category 'category list') -----
- categoryListIndex: anIndex
- 	"Set the category list index as indicated"
- 
- 	| categoryName aList found existingSelector |
- 	existingSelector := self selectedMessageName.
- 
- 	categoryListIndex := anIndex.
- 	anIndex > 0
- 		ifTrue:
- 			[categoryName := categoryList at: anIndex]
- 		ifFalse:
- 			[contents := nil].
- 	self changed: #categoryListIndex.
- 
- 	found := false.
- 	#(	(viewedCategoryName		selectorsVisited)
- 		(queryCategoryName		selectorsRetrieved)) do:
- 			[:pair |
- 				categoryName = (self class perform: pair first)
- 					ifTrue:
- 						[aList := self perform: pair second.
- 						found := true]].
- 	found ifFalse:
- 		[aList := currentVocabulary allMethodsInCategory: categoryName forInstance: self targetObject ofClass: targetClass].
- 	categoryName = self class queryCategoryName ifFalse: [autoSelectString := nil].
- 
- 	self initListFrom: aList highlighting: targetClass.
- 
- 	messageListIndex := 0.
- 	self changed: #messageList.
- 	contents := nil.
- 	self contentsChanged.
- 	self selectWithinCurrentCategoryIfPossible: existingSelector.
- 	self adjustWindowTitle!

Item was removed:
- ----- Method: Lexicon>>removeFromSelectorsVisited: (in category 'history') -----
- removeFromSelectorsVisited: aSelector
- 	"remove aSelector from my history list"
- 
- 	self selectorsVisited remove: aSelector ifAbsent: []!

Item was removed:
- ----- Method: ChangeSetCategory>>fileOutAllChangeSets (in category 'services') -----
- fileOutAllChangeSets
- 	"File out all the nonempty change sets in the current category, suppressing the checks for slips that might otherwise ensue.  Obtain user confirmation before undertaking this possibly prodigious task."
- 
- 	| aList |
- 	aList := self elementsInOrder select:
- 		[:aChangeSet  | aChangeSet isEmpty not].
- 	aList size == 0 ifTrue: [^ self inform: 'sorry, all the change sets in this category are empty'].
- 	(self confirm: 'This will result in filing out ', aList size printString, ' change set(s)
- Are you certain you want to do this?') ifFalse: [^ self].
- 
- 	Preferences setFlag: #checkForSlips toValue: false during: 
- 		[ChangesOrganizer fileOutChangeSetsNamed: (aList collect: [:m | m name]) asSortedArray]!

Item was removed:
- ----- Method: Lexicon>>removeMessage (in category 'menu commands') -----
- removeMessage
- 	"Remove the selected message from the system."
- 
- 	messageListIndex = 0 ifTrue: [^ self].
- 	self okToChange ifFalse: [^ self].
- 
- 	super removeMessage.
- 	"my #reformulateList method, called from the super #removeMethod method, will however try to preserve the selection, so we take pains to clobber it by the below..."
- 	messageListIndex := 0.
- 	self changed: #messageList.
- 	self changed: #messageListIndex.
- 	contents := nil.
- 	self contentsChanged!

Item was removed:
- ----- Method: ChangeSorter>>chooseChangeSetCategory (in category 'changeSet menu') -----
- chooseChangeSetCategory
- 	"Present the user with a list of change-set-categories and let her choose one"
- 
- 	|  cats result |
- 	self okToChange ifFalse: [^ self].
- 	Smalltalk isMorphic ifTrue: [^ self chooseChangeSetCategoryInMorphic].  "gives balloon help"
- 
- 	cats := self changeSetCategories elementsInOrder.
- 	result := UIManager default
- 		chooseFrom: (cats collect: [:cat | cat categoryName])
- 		values: cats.
- 	result ifNotNil:
- 		[changeSetCategory := result.
- 		self changed: #changeSetList.
- 		(self changeSetList includes: myChangeSet name) ifFalse:
- 			[self showChangeSet: (ChangesOrganizer changeSetNamed: self changeSetList first)].
- 		self changed: #relabel]!

Item was removed:
- ----- Method: ChangeSetCategoryWithParameters>>reconstituteList (in category 'as yet unclassified') -----
- reconstituteList
- 	"Clear out the receiver's elements and rebuild them"
- 
- 	| newMembers |
- 	"First determine newMembers and check if they have not changed..."
- 	newMembers := ChangesOrganizer allChangeSets select:
- 		[:aChangeSet | ChangesOrganizer perform: membershipSelector withArguments: { aChangeSet }, parameters].
- 	(newMembers collect: [:cs | cs name]) = keysInOrder ifTrue: [^ self  "all current"].
- 
- 	"Things have changed.  Need to recompute the whole category"
- 	self clear.
- 	newMembers do:
- 		[:aChangeSet | self fasterElementAt: aChangeSet name asSymbol put: aChangeSet]!

Item was removed:
- ----- Method: Lexicon>>limitClassString (in category 'limit class') -----
- limitClassString
- 	"Answer a string representing the current choice of most-generic-class-to-show"
- 
- 	| most |
- 	(most := self limitClass) == ProtoObject
- 		ifTrue:	[^ 'All'].
- 	most == targetClass
- 		ifTrue:	[^ most name].
- 	^ 'Only through ', most name!

Item was removed:
- ----- Method: Lexicon>>maybeReselectClass:selector: (in category 'transition') -----
- maybeReselectClass: aClass selector: aSelector
- 	"The protocol or limitClass may have changed, so that there is a different categoryList.  Formerly, the given class and selector were selected; if it is possible to do so, reselect them now"
- 
- 	aClass ifNil: [^ self].
- 	(currentVocabulary includesSelector: aSelector forInstance: self targetObject ofClass: targetClass limitClass: limitClass)
- 		ifTrue:
- 			[self selectSelectorItsNaturalCategory: aSelector]!

Item was removed:
- ----- Method: Lexicon>>buildWith: (in category 'toolbuilder') -----
- buildWith: builder
- 	"Create the ui for the browser"
- 	| windowSpec max |
- 	max := self wantsOptionalButtons ifTrue:[0.32] ifFalse:[0.4].
- 	windowSpec := self buildWindowWith: builder specs: {
- 		(0 at 0 corner: 0.5 at max) -> [self buildCategoryListWith: builder].
- 		(0.5 at 0 corner: 1 at max) -> [self buildMessageListWith: builder].
- 		(0 at max corner: 1 at 1) -> [self buildCodePaneWith: builder].
- 	}.
- 	^builder build: windowSpec!

Item was removed:
- ----- Method: Lexicon>>removeFromSelectorsVisited (in category 'history') -----
- removeFromSelectorsVisited
- 	"Remove the currently-selected method from the active set"
- 
- 	| aSelector |
- 	(aSelector := self selectedMessageName) ifNil: [^ self].
- 	self removeFromSelectorsVisited: aSelector.
- 	self chooseCategory: self class viewedCategoryName!

Item was removed:
- ----- Method: Lexicon>>categoriesPane (in category 'category list') -----
- categoriesPane
- 	"If there is a pane defined by #categoryList in my containing window, answer it, else answer nil"
- 
- 	^ self listPaneWithSelector: #categoryList!

Item was removed:
- ----- Method: Lexicon>>showMethodsInCurrentChangeSet (in category 'within-tool queries') -----
- showMethodsInCurrentChangeSet
- 	"Set the current query to be for methods in the current change set"
- 
- 	currentQuery := #currentChangeSet.
- 	autoSelectString := nil.
- 	self categoryListIndex: (categoryList indexOf: self class queryCategoryName).!

Item was removed:
- ----- Method: Lexicon>>chooseLimitClass (in category 'limit class') -----
- chooseLimitClass
- 	"Put up a menu allowing the user to choose the most generic class to show"
- 
- 	| aMenu |
- 	aMenu := MenuMorph new defaultTarget: self.
- 	targetClass withAllSuperclasses do:
- 		[:aClass | 
- 			aClass == ProtoObject
- 				ifTrue:
- 					[aMenu addLine].
- 			aMenu add: aClass name selector: #setLimitClass: argument: aClass.
- 			aClass == limitClass ifTrue:
- 				[aMenu lastItem color: Color red].
- 			aClass == targetClass ifTrue: [aMenu addLine]].
- 	aMenu addTitle: 'Show only methods
- implemented at or above...'.  "heh heh -- somebody please find nice wording here!!"
- 	aMenu popUpInWorld: self currentWorld!

Item was removed:
- ----- Method: Lexicon>>openOnClass:showingSelector: (in category 'toolbuilder') -----
- openOnClass: aTargetClass showingSelector: aSelector
- 
- 	currentVocabulary ifNil: [currentVocabulary := Vocabulary fullVocabulary].
- 	targetClass := aTargetClass.
- 	self initialLimitClass.
- 	
- 	self reformulateCategoryList.
- 	ToolBuilder open: self.
- 	self adjustWindowTitle.!

Item was removed:
- ----- Method: Lexicon>>chooseVocabulary (in category 'vocabulary') -----
- chooseVocabulary
- 	"Put up a dialog affording the user a chance to choose a different vocabulary to be installed in the receiver"
- 
- 	| aMenu |
- 	aMenu := MenuMorph new defaultTarget: self.
- 	aMenu addTitle: 'Choose a vocabulary
- blue = current
- red = imperfect' translated.
- 	aMenu addStayUpItem.
- 	Vocabulary allStandardVocabularies do:
- 		[:aVocabulary |
- 			(targetClass implementsVocabulary: aVocabulary)
- 				ifTrue:
- 					[aMenu add: aVocabulary vocabularyName selector: #switchToVocabulary: argument: aVocabulary.
- 					(targetClass fullyImplementsVocabulary: aVocabulary) ifFalse:
- 						[aMenu lastItem color: Color red].
- 					aVocabulary == currentVocabulary ifTrue:
- 						[aMenu lastItem color: Color blue]. 
- 					aMenu balloonTextForLastItem: aVocabulary documentation]].
- 	aMenu popUpInWorld: self currentWorld!

Item was removed:
- ----- Method: Lexicon>>selectorsChanged (in category 'within-tool queries') -----
- selectorsChanged
- 	"Return a list of methods in the current change set (or satisfying some 
- 	other such criterion) that are in the protocol of this object"
- 	| aList targetedClass |
- 	targetedClass := self targetObject
- 				ifNil: [targetClass]
- 				ifNotNil: [self targetObject class].
- 	aList := OrderedCollection new.
- 	ChangeSet current methodChanges
- 		associationsDo: [:classChgAssoc | classChgAssoc value
- 				associationsDo: [:methodChgAssoc | | aClass | (methodChgAssoc value == #change
- 							or: [methodChgAssoc value == #add])
- 						ifTrue: [(aClass := targetedClass whichClassIncludesSelector: methodChgAssoc key)
- 								ifNotNil: [aClass name = classChgAssoc key
- 										ifTrue: [aList add: methodChgAssoc key]]]]].
- 	^ aList!

Item was removed:
- ----- Method: Lexicon>>doItReceiver (in category 'model glue') -----
- 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.  Here, if the receiver is affiliated with a specific instance, we give give that primacy"
- 
- 	^ self targetObject ifNil: [self selectedClass ifNil: [FakeClassPool new]]!

Item was removed:
- ----- Method: Lexicon>>wantsAnnotationPane (in category 'toolbuilder') -----
- wantsAnnotationPane
- 	"This kind of browser always wants annotation panes, so answer true"
- 
- 	^ true!

Item was removed:
- ----- Method: InstanceBrowser>>inspectViewee (in category 'menu commands') -----
- inspectViewee
- 	"Open an Inspector on the object I view"
- 
- 	objectViewed inspect!

Item was removed:
- ----- Method: ChangeSorter class>>changeSetCategoryNamed: (in category 'deprecated') -----
- changeSetCategoryNamed: aName
- 
- 	^ ChangesOrganizer changeSetCategoryNamed: aName!

Item was removed:
- ElementCategory subclass: #ChangeSetCategory
- 	instanceVariableNames: 'membershipSelector'
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'Tools-Changes'!
- 
- !ChangeSetCategory commentStamp: '<historical>' prior: 0!
- A ChangeSetCategory represents a list of change sets to be shown in a ChangeSorter.  It computes whether a given change set is in the list by sending its membershipSelector to ChangeSorter (i.e. the class object) with the change set as message argument.!

Item was removed:
- ----- Method: Lexicon>>selectImplementedMessageAndEvaluate: (in category 'selection') -----
- selectImplementedMessageAndEvaluate: aBlock
- 	"Allow the user to choose one selector, chosen from the currently selected message's selector, as well as those of all messages sent by it, and evaluate aBlock on behalf of chosen selector.  If there is only one possible choice, simply make it; if there are multiple choices, put up a menu, and evaluate aBlock on behalf of the the chosen selector, doing nothing if the user declines to choose any.  In this variant, only selectors "
- 
- 	| selector method messages |
- 	(selector := self selectedMessageName) ifNil: [^ self].
- 	method := (self selectedClassOrMetaClass ifNil: [^ self])
- 		compiledMethodAt: selector
- 		ifAbsent: [].
- 	(method isNil or: [(messages := method messages) size == 0])
- 		 ifTrue: [^ aBlock value: selector].
- 	(messages size == 1 and: [messages includes: selector])
- 		ifTrue:
- 			[^ aBlock value: selector].  "If only one item, there is no choice"
- 
- 	messages := messages select: [:aSelector | currentVocabulary includesSelector: aSelector forInstance: self targetObject ofClass: targetClass limitClass: limitClass].
- 	self systemNavigation 
- 		showMenuOf: messages
- 		withFirstItem: selector
- 		ifChosenDo: [:sel | aBlock value: sel]!

Item was removed:
- ----- Method: Lexicon>>retainMethodSelectionWhileSwitchingToCategory: (in category 'transition') -----
- retainMethodSelectionWhileSwitchingToCategory: aCategoryName
- 	"retain method selection while switching the category-pane selection to show the category of the given name"
- 
- 	| aSelectedName |
- 	aSelectedName := self selectedMessageName.
- 	self categoryListIndex: (categoryList indexOf: aCategoryName ifAbsent: [^ self]).
- 	aSelectedName ifNotNil: [self selectWithinCurrentCategory: aSelectedName]
- !

Item was removed:
- ----- Method: Lexicon>>selectedClassOrMetaClass (in category 'selection') -----
- selectedClassOrMetaClass
- 	"Answer the currently selected class (or metaclass)."
- 
- 	self setClassAndSelectorIn: [:c :s | ^c]!

Item was removed:
- ----- Method: Lexicon>>seeAlso (in category 'within-tool queries') -----
- seeAlso
- 	"Present a menu offering the selector of the currently selected message, as well as of all messages sent by it.  If the chosen selector is showable in the current browser, show it here, minding unsubmitted edits however"
- 
- 	self selectImplementedMessageAndEvaluate:
- 		[:aSelector |
- 			((currentVocabulary includesSelector: aSelector forInstance: self targetObject ofClass: targetClass limitClass: limitClass)  			 "i.e., is this aSelector available in this browser"
- 					and: [self okToChange])
- 				ifTrue:
- 					[self displaySelector: aSelector]
- 				ifFalse:
- 					[Beeper beep.  "SysttemNavigation new browseAllImplementorsOf: aSelector"]].
- 					"Initially I tried making this open an external implementors browser in this case, but later decided that the user model for this was unstable"!

Item was removed:
- ----- Method: Lexicon>>selectorsRetrieved (in category 'within-tool queries') -----
- selectorsRetrieved
- 	"Anwer a list of selectors in the receiver that have been retrieved for the query category.  This protocol is used when reformulating a list after, say, a limitClass change"
- 
- 	currentQuery == #classVarRefs ifTrue: [^ self selectorsReferringToClassVar].
- 	currentQuery == #currentChangeSet ifTrue: [^ self selectorsChanged].
- 	currentQuery == #instVarDefs ifTrue: [^ self selectorsDefiningInstVar].
- 	currentQuery == #instVarRefs ifTrue: [^ self selectorsReferringToInstVar].
- 	currentQuery == #methodsWithInitials ifTrue: [^ self methodsWithInitials].
- 	currentQuery == #selectorName ifTrue: [^ self selectorsMatching].
- 	currentQuery == #senders ifTrue: [^ self selectorsSendingSelectedSelector].
- 
- 	^ #()!

Item was removed:
- ----- Method: ChangesOrganizer class>>changeSetCategoryNamed: (in category 'class initialization') -----
- changeSetCategoryNamed: aName
- 	"Answer the changeSetCategory of the given name, or nil if none"
- 
- 	^ ChangeSetCategories elementAt: aName asSymbol !

Item was removed:
- ----- Method: Lexicon>>buildCategoryListWith: (in category 'toolbuilder') -----
- buildCategoryListWith: builder
- 	| listSpec |
- 	listSpec := builder pluggableListSpec new.
- 	listSpec 
- 		model: self;
- 		list: #categoryList; 
- 		getIndex: #categoryListIndex; 
- 		setIndex: #categoryListIndex:; 
- 		menu: #categoryListMenu:shifted:; 
- 		keyPress: #categoryListKey:from:.
- 	^listSpec!

Item was removed:
- ----- Method: Lexicon>>toggleSearch (in category 'search') -----
- toggleSearch
- 	"Toggle the determination of whether a categories pane or a search pane shows"
- 
- 	self hasSearchPane
- 		ifTrue:	[self showCategoriesPane]
- 		ifFalse:	[self showSearchPane]!

Item was removed:
- ----- Method: InstanceBrowser>>viewViewee (in category 'menu commands') -----
- viewViewee
- 	"Open a viewer on the object I view"
- 
- 	objectViewed beViewed!

Item was removed:
- ----- Method: Lexicon>>useVocabulary: (in category 'vocabulary') -----
- useVocabulary: aVocabulary
- 	"Set up the receiver to use the given vocabulary"
- 
- 	currentVocabulary := aVocabulary!

Item was removed:
- ----- Method: Lexicon>>showCategory (in category 'menu commands') -----
- showCategory
- 	"A revectoring blamable on history.  Not sent in the image, but grandfathered buttons may still send this."
- 
- 	^ self showHomeCategory!

Item was removed:
- ----- Method: CodeHolder>>spawnProtocol (in category 'commands') -----
- spawnProtocol
- 	| aClassOrMetaclass |
- 	"Create and schedule a new protocol browser on the currently selected class or meta."
- 	(aClassOrMetaclass := self selectedClassOrMetaClass) ifNotNil:
-        	[ProtocolBrowser openSubProtocolForClass: aClassOrMetaclass]!

Item was removed:
- ----- Method: StringHolder>>browseFullProtocol (in category '*Tools-traits') -----
- browseFullProtocol
- 	"Open up a protocol-category browser on the value of the receiver's current selection.    If in mvc, an old-style protocol browser is opened instead.  Someone who still uses mvc might wish to make the protocol-category-browser work there too, thanks."
- 
- 	| aClass |
- 
- 	(Smalltalk isMorphic and: [Smalltalk includesKey: #Lexicon]) ifFalse: [^ self spawnFullProtocol].
- 	((aClass := self selectedClassOrMetaClass) notNil and: [aClass isTrait not]) ifTrue:
- 		[(Smalltalk at: #Lexicon) new openOnClass: aClass showingSelector: self selectedMessageName]!

Item was removed:
- ----- Method: Inspector>>browseFullProtocol (in category 'menu commands') -----
- browseFullProtocol
- 	"Open up a protocol-category browser on the value of the receiver's current selection.  If in mvc, an old-style protocol browser is opened instead."
- 
- 	| objectToRepresent |
- 	Smalltalk isMorphic ifFalse: [^ self spawnProtocol].
- 
- 	objectToRepresent := self selectionIndex == 0 ifTrue: [object] ifFalse: [self selection].
- 	InstanceBrowser new openOnObject: objectToRepresent showingSelector: nil!

Item was removed:
- ----- Method: ChangeSetCategory>>defaultChangeSetToShow (in category 'miscellaneous') -----
- defaultChangeSetToShow
- 	"Answer the name of a change-set to show"
- 
- 	^ ChangeSet current!

Item was removed:
- ChangeSetCategory subclass: #StaticChangeSetCategory
- 	instanceVariableNames: ''
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'Tools-Changes'!
- 
- !StaticChangeSetCategory commentStamp: '<historical>' prior: 0!
- StaticChangeSetCategory is a user-defined change-set category that has in it only those change sets specifically placed there.!

Item was removed:
- ----- Method: ChangeSetCategory>>fillAggregateChangeSet (in category 'services') -----
- fillAggregateChangeSet
- 	"Create a change-set named Aggregate and pour into it all the changes in all the change-sets of the currently-selected category"
- 
- 	| aggChangeSet |
- 	aggChangeSet :=  ChangesOrganizer assuredChangeSetNamed: #Aggregate.
- 	aggChangeSet clear.
- 	aggChangeSet setPreambleToSay: '"Change Set:		Aggregate
- Created at ', Time now printString, ' on ', Date today printString, ' by combining all the changes in all the change sets in the category ', categoryName printString, '"'.
- 
- 	(self elementsInOrder copyWithout: aggChangeSet) do:
- 		[:aChangeSet  | aggChangeSet assimilateAllChangesFoundIn: aChangeSet].
- 	Smalltalk isMorphic ifTrue: [SystemWindow wakeUpTopWindowUponStartup] 
- !

Item was removed:
- ----- Method: Lexicon>>chooseCategory: (in category 'category list') -----
- chooseCategory: aCategory
- 	"Choose the category of the given name, if there is one"
- 
- 	self categoryListIndex: (categoryList indexOf: aCategory ifAbsent: [^ Beeper beep])!

Item was removed:
- ----- Method: Lexicon class>>queryCategoryName (in category 'visible category names') -----
- queryCategoryName
- 	"Answer the name to be used for the query-results category"
- 
- 	true ifTrue: [^ #'-- query results --'].
- 
- 	^ '-- query results --' asSymbol   "Placed here so a message-strings-containing-it query will find this method"!

Item was removed:
- ----- Method: ChangeSorter>>makeNewCategory (in category 'changeSet menu') -----
- makeNewCategory
- 	"Create a new, static change-set category, which will be populated entirely by change sets that have been manually placed in it"
- 
- 	| catName aCategory |
- 	catName := UIManager default request: 'Please give the new category a name' initialAnswer: ''.
- 	catName isEmptyOrNil ifTrue: [^ self].
- 	catName := catName asSymbol.
- 	(self changeSetCategories includesKey: catName) ifTrue:
- 		[^ self inform: 'Sorry, there is already a category of that name'].
- 
- 	aCategory := StaticChangeSetCategory new categoryName: catName.
- 	self changeSetCategories elementAt: catName put: aCategory.
- 	aCategory addChangeSet: myChangeSet.
- 	self showChangeSetCategory: aCategory!

Item was removed:
- ----- Method: ProtocolBrowser>>on: (in category 'private') -----
- on: aClass 
- 	"Initialize with the entire protocol for the class, aClass."
- 	self initListFrom: aClass allSelectors asSortedCollection
- 		highlighting: aClass!

Item was removed:
- ----- Method: Lexicon>>showMainCategory (in category 'menu commands') -----
- showMainCategory
- 	"Continue to show the current selector, but show it within the context of its primary category.  Preserved for backward compatibility with pre-existing buttons."
- 
- 	^ self showHomeCategory!



More information about the Packages mailing list