[squeak-dev] Squeak 4.5: Protocols-bf.47.mcz

commits at source.squeak.org commits at source.squeak.org
Mon Dec 8 00:59:01 UTC 2014


Bert Freudenberg uploaded a new version of Protocols to project Squeak 4.5:
http://source.squeak.org/squeak45/Protocols-bf.47.mcz

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

Name: Protocols-bf.47
Author: bf
Time: 8 December 2014, 1:58:54.292 am
UUID: 0ef36fb5-8126-4473-9db7-10c526491c7d
Ancestors: Protocols-nice.46

Restore timestamps lost in assignment conversion.

=============== Diff against Protocols-nice.46 ===============

Item was changed:
  ----- Method: Behavior>>implementsVocabulary: (in category '*Protocols') -----
  implementsVocabulary: aVocabulary
  	"Answer whether instances of the receiver respond to the messages in aVocabulary."
  
  	(aVocabulary isKindOf: FullVocabulary orOf: ScreenedVocabulary) ifTrue: [^ true].
  	^ self fullyImplementsVocabulary: aVocabulary!

Item was changed:
  ----- Method: ButtonPhaseType>>initialize (in category 'initialization') -----
  initialize
  	"Initialize the receiver (automatically called when instances are created via 'new')"
  
  	super initialize.
  	self vocabularyName: #ButtonPhase.
  	symbols := #(buttonDown whilePressed buttonUp)!

Item was changed:
  ----- Method: CodeHolder>>spawnFullProtocol (in category '*Protocols-Tools') -----
  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 changed:
  ----- Method: CodeHolder>>spawnProtocol (in category '*Protocols-Tools') -----
  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 changed:
  ----- Method: ElementCategory>>categoryName: (in category 'category name') -----
  categoryName: aName
  	"Set the category name"
  
  	categoryName := aName!

Item was changed:
  ----- Method: ElementCategory>>clear (in category 'initialization') -----
  clear
  	"Clear the receiber's keysInOrder and elementDictionary"
  
  	keysInOrder := OrderedCollection new.
  	elementDictionary := IdentityDictionary new!

Item was changed:
  ----- Method: ElementCategory>>copyFrom: (in category 'copying') -----
  copyFrom: donor
  	"Copy the receiver's contents from the donor"
  
  	keysInOrder := donor keysInOrder.
  	elementDictionary := donor copyOfElementDictionary!

Item was changed:
  ----- Method: FullVocabulary>>allMethodsInCategory:forInstance:ofClass: (in category 'method list') -----
  allMethodsInCategory: categoryName forInstance: anObject ofClass: aClass
  	"Answer a list of all methods which are in the given category, on behalf of anObject"
  
  	| classToUse |
  	classToUse := aClass ifNil: [anObject class].
  	^ classToUse allMethodsInCategory: categoryName!

Item was changed:
  ----- Method: FullVocabulary>>categoryListForInstance:ofClass:limitClass: (in category 'category list') -----
  categoryListForInstance: anObject ofClass: aClass limitClass: mostGenericClass
  	"Answer the category list for the given object, considering only code implemented in mostGeneric and lower (or higher, depending on which way you're facing"
  
  	| classToUse |
  	classToUse := anObject ifNil: [aClass] ifNotNil: [anObject class].
  	^ mostGenericClass == classToUse
  		ifTrue:
  			[mostGenericClass organization categories]
  		ifFalse:
  			[classToUse allMethodCategoriesIntegratedThrough: mostGenericClass]!

Item was changed:
  ----- Method: FullVocabulary>>includesSelector:forInstance:ofClass:limitClass: (in category 'queries') -----
  includesSelector: aSelector forInstance: anInstance ofClass: aTargetClass limitClass: mostGenericClass
  	"Answer whether the vocabulary includes the given selector for the given class, only considering method implementations in mostGenericClass and lower"
  
  	| classToUse aClass |
  	classToUse := self classToUseFromInstance: anInstance ofClass: aTargetClass.
  	^ (aClass := classToUse whichClassIncludesSelector: aSelector)
  		ifNil:
  			[false]
  		ifNotNil:
  			[aClass includesBehavior: mostGenericClass]!

Item was changed:
  ----- Method: FullVocabulary>>initialize (in category 'initialization') -----
  initialize
  	"Initialize the receiver (automatically called when instances are created via 'new')
  Vocabulary initialize
  "
  
  	super initialize.
  	vocabularyName := #Object.
  	self documentation: '"Object" is all-encompassing vocabulary that embraces all methods understood by an object'.
  	self rigAFewCategories!

Item was changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- Method: Lexicon>>currentQueryParameter (in category 'within-tool queries') -----
  currentQueryParameter
  	"Answer the current query parameter"
  
  	^ currentQueryParameter ifNil: [currentQueryParameter := 'contents']!

Item was changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- Method: Lexicon>>limitClass: (in category 'limit class') -----
  limitClass: aClass
  	"Set the most generic class to show as indicated"
  
  	limitClass := aClass!

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

Item was changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- Method: Lexicon>>selectorsVisited (in category 'history') -----
  selectorsVisited
  	"Answer the list of selectors visited in this tool"
  
  	^ selectorsVisited ifNil: [selectorsVisited := OrderedCollection new]!

Item was changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- 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 changed:
  ----- Method: Lexicon>>useVocabulary: (in category 'vocabulary') -----
  useVocabulary: aVocabulary
  	"Set up the receiver to use the given vocabulary"
  
  	currentVocabulary := aVocabulary!

Item was changed:
  ----- Method: MethodCall>>evaluate (in category 'evaluation') -----
  evaluate
  	"Evaluate the receiver, and if value has changed, signal value-changed"
  
  	| result |
  	result := arguments isEmptyOrNil
  		ifTrue: [self receiver perform: selector]
  		ifFalse: [self receiver perform: selector withArguments: arguments asArray].
  	timeStamp := Time dateAndTimeNow.
  	result ~= lastValue ifTrue:
  		[lastValue := result.
  		self changed: #value]
  	!

Item was changed:
  ----- Method: MethodCall>>methodInterface (in category 'method interface') -----
  methodInterface
  	"Answer the receiver's methodInterface, conjuring one up on the spot (and remembering) if not present"
  
  	^ methodInterface ifNil:
  		[methodInterface := self ephemeralMethodInterface]!

Item was changed:
  ----- Method: MethodCall>>methodInterface: (in category 'method interface') -----
  methodInterface: anInterface
  	"Set my methodInterface"
  
  	methodInterface := anInterface!

Item was changed:
  ----- Method: MethodCall>>receiver:methodInterface: (in category 'initialization') -----
  receiver: aReceiver methodInterface: aMethodInterface
  	"Initialize me to have the given receiver and methodInterface"
  
  	| aResultType |
  	receiver := aReceiver.
  	selector := aMethodInterface selector.
  	methodInterface := aMethodInterface.
  	arguments := aMethodInterface defaultArguments.
  
  	self flag: #noteToTed.
  	"the below can't really survive, I know.  The intent is that if the method has a declared result type, we want the preferred readout type to be able to handle the initial #lastValue even if the MethodCall has not been evaluated yet; thus we'd rather have a boolean value such as true rather than a nil here if we're showing a boolean readout such as a checkbox, and likewise for color-valued and numeric-valued readouts etc, "
  
  	(aResultType := methodInterface resultType) ~~ #unknown ifTrue:
  		[lastValue := (Vocabulary vocabularyForType: aResultType) initialValueForASlotFor: aReceiver]        !

Item was changed:
  ----- Method: MethodCall>>receiver:methodInterface:initialArguments: (in category 'initialization') -----
  receiver: aReceiver methodInterface: aMethodInterface initialArguments: initialArguments
  	"Set up a method-call for the given receiver, method-interface, and initial arguments"
  
  	receiver := aReceiver.
  	selector := aMethodInterface selector.
  	methodInterface := aMethodInterface.
  	arguments := initialArguments ifNotNil: [initialArguments asArray]
  !

Item was changed:
  ----- Method: MethodCall>>setArgumentNamed:toValue: (in category 'argument access') -----
  setArgumentNamed: aName toValue: aValue
  	"Set the argument of the given name to the given value"
  
  	| anIndex |
  	anIndex := self methodInterface argumentVariables findFirst:
  		[:aVariable | aVariable variableName = aName].
  	anIndex > 0
  		ifTrue:
  			[arguments at: anIndex put: aValue]
  		ifFalse:
  			[self error: 'argument missing'].
  	self changed: #argumentValue!

Item was changed:
  ----- Method: MethodCall>>valueOfArgumentNamed: (in category 'initialization') -----
  valueOfArgumentNamed: aName
  	"Answer the value of the given arguement variable"
  
  	| anIndex |
  	anIndex := self methodInterface argumentVariables findFirst:
  		[:aVariable | aVariable variableName = aName].
  	^ anIndex > 0
  		ifTrue:
  			[arguments at: anIndex]
  		ifFalse:
  			[self error: 'variable not found']!

Item was changed:
  ----- Method: MethodInterface>>argumentVariables (in category 'initialization') -----
  argumentVariables
  	"Answer the list of argumentVariables of the interface"
  
  	^ argumentVariables ifNil: [argumentVariables := OrderedCollection new]!

Item was changed:
  ----- Method: MethodInterface>>argumentVariables: (in category 'initialization') -----
  argumentVariables: variableList
  	"Set the argument variables"
  
  	argumentVariables := variableList!

Item was changed:
  ----- Method: MethodInterface>>attributeKeywords (in category 'attribute keywords') -----
  attributeKeywords
  	"Answer a list of attribute keywords associated with the receiver"
  
  	^ attributeKeywords ifNil: [attributeKeywords := OrderedCollection new]!

Item was changed:
  ----- Method: MethodInterface>>conjuredUpFor:class: (in category 'initialization') -----
  conjuredUpFor: aSelector class: aClass
  	"Initialize the receiver to have the given selector, obtaining whatever info one can from aClass.  This basically covers the situation where no formal definition has been made."
  
  	| parts |
  	self initializeFor: aSelector.
  	self wording: aSelector.
  
  	receiverType := #unknown.
  	parts := aClass formalHeaderPartsFor: aSelector.
  	argumentVariables := (1 to: selector numArgs) collect:
  		[:anIndex | Variable new name: (parts at: (4 * anIndex)) type: #Object].
  	parts last isEmptyOrNil ifFalse: [self documentation: parts last].
  !

Item was changed:
  ----- Method: MethodInterface>>defaultStatus: (in category 'status') -----
  defaultStatus: aStatus
  	"Set the receiver's defaultStatus as indicated"
  
  	defaultStatus := aStatus!

Item was changed:
  ----- Method: MethodInterface>>initialize (in category 'initialization') -----
  initialize
  	"Initialize the receiver"
  
  	super initialize.
  	attributeKeywords := OrderedCollection new.
  	defaultStatus := #normal.
  	argumentVariables := OrderedCollection new
  !

Item was changed:
  ----- Method: MethodInterface>>initializeFor: (in category 'initialization') -----
  initializeFor: aSelector
  	"Initialize the receiver to have the given selector"
  
  	selector := aSelector.
  	attributeKeywords := OrderedCollection new.
  	defaultStatus := #normal
  !

Item was changed:
  ----- Method: MethodInterface>>initializeSetterFromEToySlotSpec: (in category 'initialization') -----
  initializeSetterFromEToySlotSpec: tuple
  	"tuple holds an old etoy slot-item spec, of the form found in #additionsToViewerCategories methods.   Initialize the receiver to represent the getter of this item"
  
  	selector := tuple ninth.
  	self
  		wording: ('set ', tuple second);
  		helpMessage: ('setter for', tuple third).
  	receiverType := #Player.
  	argumentVariables := Array with: (Variable new variableType: tuple fourth)
  	!

Item was changed:
  ----- Method: MethodInterface>>receiverType (in category 'access') -----
  receiverType
  	"Answer the receiver type"
  
  	^ receiverType ifNil: [receiverType := #unknown]!

Item was changed:
  ----- Method: MethodInterface>>receiverType: (in category 'initialization') -----
  receiverType: aType
  	"set the receiver type.  Whether the receiverType earns its keep here is not yet well understood.  At the moment, this is unsent"
  
  	receiverType := aType!

Item was changed:
  ----- Method: MethodInterface>>resultType: (in category 'initialization') -----
  resultType: aType
  	"Set the receiver's resultSpecification to be a ResultType of the given type"
  
  	resultSpecification := ResultSpecification new.
  	resultSpecification resultType: aType!

Item was changed:
  ----- Method: MethodInterface>>selector:type:setter: (in category 'attribute keywords') -----
  selector: aSelector type: aType setter: aSetter
  	"Set the receiver's fields as indicated.  Values of nil or #none for the result type and the setter indicate that there is none"
  
  	selector := aSelector.
  	(MethodInterface isNullMarker: aType) ifFalse:
  		[resultSpecification := ResultSpecification new.
  		resultSpecification resultType: aType.
  		(MethodInterface isNullMarker: aSetter) ifFalse:
  			[resultSpecification companionSetterSelector: aSetter]]!

Item was changed:
  ----- Method: MethodInterface>>typeForArgumentNumber: (in category 'access') -----
  typeForArgumentNumber: anArgumentNumber
  	"Answer the data type for the given argument number"
  
  	| aVariable |
  	aVariable := self argumentVariables at: anArgumentNumber.
  	^ aVariable variableType!

Item was changed:
  ----- Method: ObjectWithDocumentation>>initialize (in category 'initialization') -----
  initialize
  	"Initialize the receiver (automatically called when instances are created via 'new')"
  
  	authoringStamp := Utilities changeStampPerSe
  !

Item was changed:
  ----- Method: ObjectWithDocumentation>>legacyHelpMessage (in category 'accessing') -----
  legacyHelpMessage
  	"If I have a help message stashed in my legacy naturalTranslations slot, answer its translated rendition, else answer nil.  If I *do* come across a legacy help message, transfer it to my properties dictionary."
  
  	| untranslated |
  	naturalLanguageTranslations isEmptyOrNil  "only in legacy (pre-3.8) projects"
  		ifTrue: [^ nil].
  	untranslated := naturalLanguageTranslations first helpMessage ifNil: [^ nil].
  	self propertyAt: #helpMessage put: untranslated.
  	naturalLanguageTranslations removeFirst.
  	naturalLanguageTranslations isEmpty ifTrue: [naturalLanguageTranslations := nil].
  	^ untranslated translated!

Item was changed:
  ----- 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 changed:
  ----- Method: ResultSpecification>>companionSetterSelector: (in category 'companion setter') -----
  companionSetterSelector: aSetterSelector
  	"Set the receiver's companionSetterSelector as indicated"
  
  	companionSetterSelector := aSetterSelector!

Item was changed:
  ----- Method: ResultSpecification>>refetchFrequency: (in category 'refetch') -----
  refetchFrequency: aFrequency
  	"Set the refetch frequency"
  
  	refetchFrequency := aFrequency!

Item was changed:
  ----- Method: ResultSpecification>>resultType: (in category 'result type') -----
  resultType: aType
  	"Set the receiver's resultType as specified"
  
  	type := aType!

Item was changed:
  ----- Method: ScreenedVocabulary>>categoryScreeningBlock: (in category 'initialization') -----
  categoryScreeningBlock: aBlock
  	"Set the receiver's categoryScreeningBlock to the block provided"
  
  	categoryScreeningBlock := aBlock!

Item was changed:
  ----- Method: ScreenedVocabulary>>initialize (in category 'initialization') -----
  initialize
  	"Initialize the receiver (automatically called when instances are created via 'new')"
  
  	super initialize.
  	vocabularyName :=  #Public.
  	self documentation: '"Public" is vocabulary that excludes categories that start with "private" and methods that start with "private" or "pvt"'!

Item was changed:
  ----- Method: ScreenedVocabulary>>methodScreeningBlock: (in category 'initialization') -----
  methodScreeningBlock: aBlock
  	"Set the receiver's methodScreeningBlock to the block provided"
  
  	methodScreeningBlock := aBlock!

Item was changed:
  ----- Method: SymbolListType>>symbols: (in category 'tiles') -----
  symbols: symbolList
  	"Set the receiver's list of symbols as indicated"
  
  	symbols := symbolList!

Item was changed:
  ----- Method: UnknownType>>initialize (in category 'initialization') -----
  initialize
  	"Initialize the receiver (automatically called when instances are created via 'new')"
  
  	super initialize.
  	vocabularyName := #unknown!

Item was changed:
  ----- Method: Variable>>name:type: (in category 'name') -----
  name: aName type: aType
  	"Set the variable's name and type as indicated"
  
  	variableName := aName.
  	variableType := aType!

Item was changed:
  ----- Method: Variable>>sample (in category 'value') -----
  sample
  	"The closest we can come to an object for our type"
  
  	| ty clsName |
  	self defaultValue ifNotNil: [^ self defaultValue].
  	ty := self variableType.
  	"How translate a type like #player into a class?"
  	clsName := ty asString.
  	clsName at: 1 put: (clsName first asUppercase).
  	clsName := clsName asSymbol.
  	(Smalltalk includesKey: clsName) ifFalse: [self error: 'What type is this?'. ^ 5].
  	^ (Smalltalk at: clsName) initializedInstance!

Item was changed:
  ----- Method: Variable>>variableType: (in category 'type') -----
  variableType: aType
  	"Set the receiver's variable type as requested"
  
  	variableType := aType!

Item was changed:
  ----- Method: Vocabulary class>>allStandardVocabularies (in category 'standard vocabulary access') -----
  allStandardVocabularies
  	"Answer a list of the currently-defined vocabularies in my AllStandardVocabularies list"
  	"Vocabulary allStandardVocabularies"
  
  	^AllStandardVocabularies ifNil: [AllStandardVocabularies := IdentityDictionary new].
  
  !

Item was changed:
  ----- Method: Vocabulary class>>newPublicVocabulary (in category 'universal vocabularies') -----
  newPublicVocabulary
  	| aVocabulary |
  	"Answer a public vocabulary"
  
  	aVocabulary := ScreenedVocabulary new.
  	aVocabulary vocabularyName: #Public.
  	aVocabulary documentation: '"Public" is vocabulary that excludes categories that start with "private" and methods that start with "private" or "pvt"'.
  
  	aVocabulary categoryScreeningBlock: [:aCategoryName | (aCategoryName beginsWith: 'private') not].
  	aVocabulary methodScreeningBlock: [:aSelector | 
  		((aSelector beginsWith: 'private') or: [aSelector beginsWith: 'pvt']) not].
  	^ aVocabulary
  !

Item was changed:
  ----- Method: Vocabulary class>>newQuadVocabulary (in category 'testing and demo') -----
  newQuadVocabulary
  	"Answer a Quad vocabulary -- something to mess with, to illustrate and explore ideas.  Applies to Quadrangles only."
  
  	| aVocabulary  |
  	aVocabulary := Vocabulary new vocabularyName: #Quad.
  	aVocabulary documentation: 'A highly restricted test vocabulary that can be used with Quadrangle objects'.
  	aVocabulary initializeFromTable:  #(
  (borderColor borderColor: () Color (basic color) 'The color of the border' unused updating)
  (borderWidth borderWidth: () Number (basic geometry) 'The width of the border' unused updating)
  (insideColor insideColor: () Color (basic color) 'The color of the quadrangle' unused updating)
  (display none () none (basic display) 'Display the quadrangle directly on the screen')
  (width none () Number (geometry) 'The width of the object' unused updating)
  (left setLeft: () Number (geometry) 'The left edge' unused updating)
  (right setRight: () Number (geometry) 'The right edge' unused updating)
  (width setWidth: () Number (geometry) 'The width of the object' unused updating)
  (height setHeight: () Number (geometry) 'The height of the object' unused updating)
  (hasPositiveExtent none () Boolean (tests) 'Whether the corner is to the lower-right of the origin' unused updating)
  (isTall none () Boolean (tests) 'Whether the height is greater than the width' unused updating)).
  
  	^ aVocabulary
  
  "Vocabulary initialize"
  "Quadrangle exampleInViewer"!

Item was changed:
  ----- Method: Vocabulary class>>newTestVocabulary (in category 'testing and demo') -----
  newTestVocabulary
  	"Answer a Test vocabulary -- something to mess with, to illustrate and explore ideas."
  
  	| aVocabulary  |
  	aVocabulary := Vocabulary new vocabularyName: #Test.
  	aVocabulary documentation: 'An illustrative vocabulary for testing'.
  	aVocabulary initializeFromTable:  #(
  (isKindOf: none 	((aClass Class)) Boolean (#'class membership') 'answer whether the receiver''s superclass chain includes aClass')
  (class none none Class (#'class membership' wimpy) 'answer the the class to which the receiver belongs')
  (respondsTo: none ((aSelector Symbol))	Boolean (#'class membership') 'answer whether the receiver responds to the given selector')
  (as:	none ((aClass Class)) Object (conversion) 'answer the receiver converted to be a member of aClass')).
  
  	^ aVocabulary
  "
  	#((#'class membership' 	'Whether an object can respond to a given message, etc.' 	(isKindOf: class respondsTo:))
  	(conversion 			'Messages to convert from one kind of object to another' 		(as:  asString))
  	(copying				'Messages for making copies of objects'						(copy copyFrom:))
  	(equality 				'Testing whether two objects are equal' 						( = ~= == ~~))
  	(dependents				'Support for dependency notification'						(addDependent: removeDependent: release))) do:
  
  		[:item | 
  			aMethodCategory := ElementCategory new categoryName: item first.
  			aMethodCategory documentation: item second.
  			item third do:
  				[:aSelector | 
  					aMethodInterface := MethodInterface new initializeFor: aSelector.
  					aVocabulary atKey: aSelector putMethodInterface: aMethodInterface.
  					aMethodCategory elementAt: aSelector put: aMethodInterface].
  			aVocabulary addCategory: aMethodCategory]."
  !

Item was changed:
  ----- Method: Vocabulary class>>vocabularyForClass: (in category 'type vocabularies') -----
  vocabularyForClass: aClass
  	"Answer the standard vocabulary for that class.  Create it if not present and init message exists.  Answer nil if none exists and no init message present."
  
  	| initMsgName newTypeVocab |
  	(self allStandardVocabularies includesKey: aClass name)
  		ifTrue: [^self allStandardVocabularies at: aClass name].
  
  	initMsgName := ('new', aClass name, 'Vocabulary') asSymbol.
  	^(self respondsTo: initMsgName)
  		 ifTrue:	[
  			newTypeVocab := self perform: initMsgName.
  			self addStandardVocabulary: newTypeVocab.
  			newTypeVocab]
  		ifFalse: [nil]!

Item was changed:
  ----- Method: Vocabulary class>>vocabularyForType: (in category 'type vocabularies') -----
  vocabularyForType: aType
  	"Answer a vocabulary appropriate to the given type, which is normally going to be a symbol such as #Number or #Color.  Answer the Unknown vocabulary as a fall-back"
  
  	| ucSym |
  	(aType isKindOf: Vocabulary) ifTrue: [^ aType].
  	ucSym := aType capitalized asSymbol.
  	^self allStandardVocabularies at: ucSym ifAbsent: [self vocabularyNamed: #unknown]!

Item was changed:
  ----- Method: Vocabulary>>allMethodsInCategory:forInstance:ofClass: (in category 'queries') -----
  allMethodsInCategory: categoryName forInstance: anObject ofClass: aClass
  	"Answer a list of all methods in the etoy interface which are in the given category, on behalf of aClass and possibly anObject.  Note that there is no limitClass at play here."
  
  	| aCategory |
  	categoryName ifNil: [^ OrderedCollection new].
  	categoryName = self allCategoryName ifTrue:
  		[^ methodInterfaces collect: [:anInterface | anInterface selector]].
  
  	aCategory := categories detect: [:cat | cat categoryName == categoryName asSymbol] ifNone: [^ OrderedCollection new].
  	^ aCategory elementsInOrder collect: [:anElement | anElement selector] thenSelect:
  			[:aSelector | aClass canUnderstand: aSelector]!

Item was changed:
  ----- Method: Vocabulary>>categoryWordingAt: (in category 'queries') -----
  categoryWordingAt: aSymbol
  	"Answer the wording for the category at the given symbol"
  
  	| result |
  	result := self categoryAt: aSymbol.
  	^result
  		ifNotNil: [result wording]
  		ifNil: [aSymbol]!

Item was changed:
  ----- Method: Vocabulary>>includesSelector:forInstance:ofClass:limitClass: (in category 'queries') -----
  includesSelector: aSelector forInstance: anInstance ofClass: aTargetClass limitClass: mostGenericClass
  	"Answer whether the vocabulary includes the given selector for the given class (and instance, if provided), only considering method implementations in mostGenericClass and lower"
  
  	| classToUse aClass |
  
  	(methodInterfaces includesKey: aSelector) ifFalse: [^ false].
  	classToUse := self classToUseFromInstance: anInstance ofClass: aTargetClass.
  	^ (aClass := classToUse whichClassIncludesSelector: aSelector)
  		ifNil:
  			[false]
  		ifNotNil:
  			[(aClass includesBehavior: mostGenericClass) and:
  				[(self someCategoryThatIncludes: aSelector) notNil]]
  !

Item was changed:
  ----- Method: Vocabulary>>initialize (in category 'initialization') -----
  initialize
  	"Initialize the receiver (automatically called when instances are created via 'new')"
  
  	super initialize.
  	vocabularyName := #unnamed.
  	categories := OrderedCollection new.
  	methodInterfaces := IdentityDictionary new!

Item was changed:
  ----- Method: Vocabulary>>initializeFor: (in category 'initialization') -----
  initializeFor: anObject
  	"Initialize the receiver to bear a vocabulary suitable for anObject"
  
  	object := anObject.
  	vocabularyName := #unnamed.
  	categories := OrderedCollection new.
  	methodInterfaces := IdentityDictionary new.
  	self documentation: 'A vocabulary that has not yet been documented'.
  !

Item was changed:
  ----- Method: Vocabulary>>renameCategoryFrom:to: (in category 'initialization') -----
  renameCategoryFrom: oldName to: newName
  	"Rename the category currently known by oldName to be newName.  No senders at present but once a UI is establshed for renaming categories, this will be useful."
  
  	| aCategory |
  	(aCategory := self categoryAt: oldName) ifNil: [^ self].
  	aCategory categoryName: newName!

Item was changed:
  ----- Method: Vocabulary>>vocabularyName: (in category 'initialization') -----
  vocabularyName: aName
  	"Set the name of the vocabulary as indicated"
  
  	vocabularyName := aName!



More information about the Squeak-dev mailing list