The Trunk: Protocols-jr.63.mcz

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

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

Name: Protocols-jr.63
Author: jr
Time: 4 August 2019, 11:40:18.213513 am
UUID: 7921d09f-b335-5e4e-bb85-ace62a287eb7
Ancestors: Protocols-pre.62

Implement spontaneous overriding of methods from Lexicon.

Use a new instance variable to temporarily hold which class is the target of the current accept operation.
Make sure to update the message list in case the current selector's class has now changed.

Assumption: setClassAndSelectorIn: must provide the data of the currently selected method and it will not pretend to view a different class.

Also add browseFullProtocol to ClassDescription to make it easier to open a Lexicon from a Workspace or the search box.

Depends on Tools-jr.859.

=============== 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 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!