[squeak-dev] The Trunk: Protocols-jr.66.mcz

commits at source.squeak.org commits at source.squeak.org
Wed Aug 14 09:05:25 UTC 2019


Marcel Taeumel uploaded a new version of Protocols to project The Trunk:
http://source.squeak.org/trunk/Protocols-jr.66.mcz

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

Name: Protocols-jr.66
Author: jr
Time: 10 August 2019, 10:52:44.688208 pm
UUID: d24c7b8e-2920-0a46-9a93-e89755df5ad4
Ancestors: Protocols-jr.65

Quick fix to highlight messages implemented in the browsed class of a Lexicon again

=============== Diff against Protocols-pre.62 ===============

Item was added:
+ ----- Method: ClassDescription>>browseFullProtocol (in category '*Protocols-Tools') -----
+ browseFullProtocol
+ 	Lexicon new openOnClass: self showingSelector: nil.!

Item was changed:
  ProtocolBrowser subclass: #Lexicon
+ 	instanceVariableNames: 'currentVocabulary categoryList categoryListIndex targetClass limitClass currentQuery currentQueryParameter selectorsVisited compileTargetClass'
- 	instanceVariableNames: 'currentVocabulary categoryList categoryListIndex targetClass limitClass currentQuery currentQueryParameter selectorsVisited'
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'Protocols-Tools'!
  
+ !Lexicon commentStamp: 'jr 8/4/2019 11:36' prior: 0!
- !Lexicon commentStamp: 'fbs 5/2/2013 08:29' prior: 0!
  An instance of Lexicon shows the 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
+ compileTargetClass		transient -- behavior in which the current contents is 
+ 							accepted/compiled!
- 							#senders #selectorName #currentChangeSet!

Item was added:
+ ----- Method: Lexicon>>contents:notifying: (in category 'private') -----
+ contents: aString notifying: aController 
+ 	"Make sure a possible choice of the compileTargetClass is not remembered."
+ 	[^ super contents: aString notifying: aController]
+ 		ensure: [compileTargetClass := nil]!

Item was added:
+ ----- Method: Lexicon>>contents:oldSelector:in:classified:notifying: (in category 'private') -----
+ contents: aString oldSelector: oldSelector in: aClass classified: category notifying: aController
+ 	"Update messageList if a method is compiled because the selector might be in a
+ 	different class now."
+ 	^ (super contents: aString oldSelector: oldSelector in: aClass classified: category notifying: aController)
+ 		ifTrue: [	self reformulateList. ^ true]
+ 		ifFalse: [false]!

Item was added:
+ ----- Method: Lexicon>>formattedLabel:forSelector:inClass: (in category 'message list') -----
+ formattedLabel: aString forSelector: aSymbol inClass: aClass
+ 	"Highlight messages implemented in the targetClass in bold print."
+ 	
+ 	| formattedLabel |
+ 	formattedLabel := super formattedLabel: aString forSelector: aSymbol inClass: aClass.
+ 	aClass = targetClass ifTrue:
+ 		[formattedLabel := formattedLabel asText.
+ 		(self userInterfaceTheme ownMessageAttributes ifNil: [{TextEmphasis bold}]) do: [:textAttribute |
+ 			formattedLabel addAttribute: textAttribute]].
+ 
+ 	^ formattedLabel.!

Item was changed:
  ----- Method: Lexicon>>messageHelpAt: (in category 'message list') -----
  messageHelpAt: anIndex
+ 	"Show the first n lines of the source code of the selected message."
+ 	Preferences balloonHelpInMessageLists ifFalse: [^ nil].
+ 	self messageList size < anIndex ifTrue: [^ nil].
+ 	
+ 	self class parse: (self messageList at: anIndex) toClassAndSelector:
+ 		[:class :selector |
+ 		^ self messageHelpForMethod: class >> selector].
+ 	
- 	"Not working due to text representation of message list."
  	^ nil!

Item was changed:
  ----- Method: Lexicon>>messageIconAt: (in category 'message list') -----
  messageIconAt: anIndex
+ 	Browser showMessageIcons
+ 		ifFalse: [^ nil].
+ 	self class parse: (self messageList at: anIndex) toClassAndSelector:
+ 		[:class :selector |
+ 		^ ToolIcons iconNamed: (ToolIcons
+ 			iconForClass: class
+ 			selector: selector)].
+ 	
- 	"Not working due to text representation of message list."
  	^ nil!

Item was changed:
  ----- Method: Lexicon>>okayToAccept (in category 'model glue') -----
  okayToAccept
  	"Answer whether it is okay to accept the receiver's input"
  
+ 	| ok reply |
- 	| ok aClass reply |
  	(ok := super okayToAccept) ifTrue:
+ 		[((compileTargetClass := self selectedClassOrMetaClass) ~~ targetClass) 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:
- 	{'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 ', compileTargetClass name, '.
+ Is that okay?'.
+ 			reply caseOf:
+ 				{[1] -> [^ true].
+ 				[2] -> [^ false].
+ 				[3] -> [compileTargetClass := targetClass. ^ true]}
+ 				otherwise: [self notYetImplemented]]].
- accepted into class ', aClass name, '.
- Is that okay?' .
- 			reply = 1 ifTrue: [^ true].
- 			reply ~= 2 ifTrue:
- 				[self notYetImplemented].
- 			^ false]].
  	^ ok!

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 added:
+ ----- Method: Lexicon>>targetForContents: (in category 'private') -----
+ targetForContents: aString
+ 	^ compileTargetClass!

Item was added:
+ ----- Method: ProtocolBrowser class>>parse:toClassAndSelector: (in category 'utilities') -----
+ parse: aStringOrText toClassAndSelector: csBlock
+ 	"Decode strings of the form    <selectorName> (<className> [class])"
+ 	| string i classAndSelString|
+ 	aStringOrText ifNil: [^ csBlock value: nil value: nil].
+ 	string := aStringOrText asString.
+ 	i := string indexOf: $(.
+ 	"Rearrange to  <className> [class] <selectorName> , and use MessageSet"
+ 	classAndSelString := (string copyFrom: i + 1 to: string size - 1) , ' ' ,
+ 						(string copyFrom: 1 to: i - 1) withoutTrailingBlanks.
+ 	super parse: classAndSelString toClassAndSelector: csBlock.!

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.
- 	].
- !



More information about the Squeak-dev mailing list