The Trunk: Protocols-ul.34.mcz

Levente Uzonyi uploaded a new version of Protocols to project The Trunk:
http://source.squeak.org/trunk/Protocols-ul.34.mcz

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

Name: Protocols-ul.34
Author: ul
Time: 16 November 2010, 5:02:00.371 am
UUID: cacf90e6-cc22-d24a-a34d-cf126d1d326a
Ancestors: Protocols-nice.33

- use #= for integer comparison instead of #== (http://bugs.squeak.org/view.php?id=2788 )

=============== Diff against Protocols-nice.33 ===============

Item was changed:
  ----- Method: Inspector>>browseFullProtocol (in category '*Protocols-Tools') -----
  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].
- objectToRepresent := self selectionIndex == 0 ifTrue: [object] ifFalse: [self selection].
  InstanceBrowser new openOnObject: objectToRepresent showingSelector: nil!

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

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

Item was changed:
  ----- 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].
- 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 changed:
  ----- 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].
- 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 changed:
  ----- 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].
- (fragment := fragment copyWithout: $ ) size == 0  ifTrue: [^ self].
  currentQueryParameter := fragment.
  fragment := fragment asLowercase.
  currentQuery := #selectorName.
  self showQueryResultsCategory.
  self messageListIndex: 0!

Item was changed:
  ----- 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:
- reply ~~ 2 ifTrue:
  [self notYetImplemented].
  ^ false]].
  ^ ok!

Item was changed:
  ----- 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])
- (method isNil or: [(messages := method messages) size == 0])
  ifTrue: [^ aBlock value: selector].
+ (messages size = 1 and: [messages includes: 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 changed:
  ----- Method: Lexicon>>selectedMessage (in category 'selection') -----
  selectedMessage
  "Answer the source method for the currently selected message."
 
+ (categoryList notNil and: [(categoryListIndex isNil or: [categoryListIndex = 0])])
- (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 changed:
  ----- 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:
- aList size == 0 ifTrue:
  [^ Beeper beep].
  self initListFrom: aList asSortedArray highlighting: targetClass.
  messageListIndex :=  messageListIndex min: messageList size.
  self changed: #messageList
  !