The Trunk: Protocols-jr.67.mcz

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

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

Name: Protocols-jr.67
Author: jr
Time: 10 August 2019, 11:17:13.691208 pm
UUID: 47e86587-b8a1-6341-b25f-624fe55eb0e4
Ancestors: Protocols-jr.66

Harden against missing methods.

Endless debuggers appeared when a message list item whose method was removed from the system was hovered. This can happen if you have an existing message list that was not updated since the method has been removed.

=============== 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 compiledMethodAt: selector ifAbsent: [^ nil])].
+
- "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.
- ].
- !