The Inbox: Tools-ct.956.mcz

Christoph Thiede uploaded a new version of Tools to project The Inbox:
http://source.squeak.org/inbox/Tools-ct.956.mcz

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

Name: Tools-ct.956
Author: ct
Time: 7 March 2020, 5:37:18.187886 pm
UUID: 6c945d3e-bebf-354b-9d77-db3ae4f619ca
Ancestors: Tools-mt.955

Fixes a bug in DebuggerMethodMap's rangeForPC lookup

Steps to reproduce:

        c := Object newSubclass.
        c compile: 'foo: foo
                foo = #foo ifTrue: [^ true].
                ^ (foo ifNil: [^ false]) = #bar'.
        c new foo: #bar.
        "Debug it. Step into #foo:, step over #=.
        Before this commit, the selection was '^ true'"

The error was that #findNearbyBinaryIndex: uses to return the lower possible index if there is no exact match. For debugging, we cannot need this behavior, because we want to select the next operation to be executed.

Furthermore, this commit refactors some duplication with DebuggerMethodMapForFullBlockCompiledMethod. Please review!

=============== Diff against Tools-mt.955 ===============

Item was changed:
  ----- Method: Browser>>browseAllCommentsForClass (in category 'message functions') -----
  browseAllCommentsForClass
  "Opens a HelpBrowser on the class"
 
  | myClass |
+ myClass := self selectedClassOrMetaClass ifNil: [^ self].
+ myClass isTrait ifTrue: [^ self].
- myClass := self selectedClassOrMetaClass ifNil: [ ^self ].
- myClass isTrait ifTrue: [ ^self ].
  (Smalltalk classNamed: #HelpBrowser)
+ ifNil: [^ self inform: 'HelpBrowser is not available.' translated]
- ifNil: [ ^self inform: 'HelpBrowser is not available.' ]
  ifNotNil: [ :HelpBrowser |
  HelpBrowser openOn: myClass theNonMetaClass ]
  !

Item was removed:
- ----- Method: Browser>>browseClassHierarchy (in category 'multi-window support') -----
- browseClassHierarchy
- "Overridden to consider multi-window state and hierarchy browser."
-
- | behavior newBrowser |
- (behavior := self selectedClassOrMetaClass) isNil ifTrue:
- [^self].
-
- (self isPackage "PackageBrowser panes can't support a hierarchy browser; not sure why."
- or: [self multiWindowState isNil]) ifTrue:
- [^super browseClassHierarchy].
-
- (newBrowser := HierarchyBrowser new initHierarchyForClass: behavior)
- selectMessageCategoryNamed: self selectedMessageCategoryName;
- selectMessageNamed: self selectedMessageName;
- editSelection: editSelection.
-
- self multiWindowState addWindow: newBrowser!

Item was changed:
  ----- Method: Browser>>buildMessageCategoryListWith: (in category 'toolbuilder') -----
  buildMessageCategoryListWith: builder
+
  | listSpec |
  listSpec := builder pluggableListSpec new.
  listSpec
  model: self;
  list: #messageCategoryList;
  getIndex: #messageCategoryListIndex;
  setIndex: #messageCategoryListIndex:;
  menu: #messageCategoryMenu:;
  keyPress: #messageCategoryListKey:from:.
+ SystemBrowser browseWithDragNDrop ifTrue: [
- SystemBrowser browseWithDragNDrop ifTrue:[
  listSpec
  dropAccept: #wantsMessageCategoriesDrop:;
+ dropItem: #dropOnMessageCategories:at:shouldCopy:].
+ ^ listSpec!
- dropItem: #dropOnMessageCategories:at:].
- ^listSpec
- !

Item was changed:
  ----- Method: Browser>>buildMessageListWith: (in category 'toolbuilder') -----
  buildMessageListWith: builder
  | listSpec |
  listSpec := builder pluggableListSpec new.
  listSpec
  model: self;
  list: #messageList;
  getIndex: #messageListIndex;
  setIndex: #messageListIndex:;
  icon: #messageIconAt:;
  helpItem: #messageHelpAt:;
  menu: #messageListMenu:shifted:;
  keyPress: #messageListKey:from:.
+ SystemBrowser browseWithDragNDrop ifTrue: [
+ listSpec
+ dragItem: #dragFromMessageList:;
+ draggedItem: #draggedFromMessageList:wasCopy:].
- SystemBrowser browseWithDragNDrop
- ifTrue:[listSpec dragItem: #dragFromMessageList:].
  ^listSpec
  !

Item was added:
+ ----- Method: Browser>>classHierarchy (in category 'multi-window support') -----
+ classHierarchy
+ | behavior newBrowser |
+ (behavior := self selectedClassOrMetaClass) isNil ifTrue:
+ [^self].
+
+ (self isPackage "PackageBrowser pains can't support a hierarchy browser; not sure why."
+ or: [self multiWindowState isNil]) ifTrue:
+ [^super classHierarchy].
+
+ (newBrowser := HierarchyBrowser new initHierarchyForClass: behavior)
+ selectMessageCategoryNamed: self selectedMessageCategoryName;
+ selectMessageNamed: self selectedMessageName;
+ editSelection: editSelection.
+
+ self multiWindowState addWindow: newBrowser
+ !

Item was changed:
  ----- Method: Browser>>defaultBrowserTitle (in category 'initialize-release') -----
  defaultBrowserTitle
+ ^ 'System Browser'!
- | title |
- title := 'System Browser'.
- ^ self environment = self class environment
- ifTrue: [title]
- ifFalse: [title, ' on environment ', self environment asString]!

Item was changed:
  ----- Method: Browser>>defineMessageFrom:notifying: (in category 'message functions') -----
  defineMessageFrom: aString notifying: aController
  "Compile the expressions in aString. Notify aController if a syntax error occurs. Install the compiled method in the selected class classified under  the currently selected message category name. Answer the selector obtained if compilation succeeds, nil otherwise."
  | selectedMessageName selector category oldMessageList selectedClassOrMetaClass |
  selectedMessageName := self selectedMessageName.
  oldMessageList := self messageList.
  selectedClassOrMetaClass := self selectedClassOrMetaClass.
  contents := nil.
+ selector := selectedClassOrMetaClass newParser parseSelector: aString.
- selector := (selectedClassOrMetaClass newParser parseSelector: aString).
  (self metaClassIndicated
  and: [(selectedClassOrMetaClass includesSelector: selector) not
  and: [Metaclass isScarySelector: selector]])
  ifTrue: ["A frist-time definition overlaps the protocol of Metaclasses"
  (self confirm: ((selector , ' is used in the existing class system.
  Overriding it could cause serious problems.
  Is this really what you want to do?') asText makeBoldFrom: 1 to: selector size))
  ifFalse: [^nil]].
  category := selectedMessageName
  ifNil: [ self selectedMessageCategoryName ]
  ifNotNil: [ (selectedClassOrMetaClass >> selectedMessageName) methodReference ifNotNil: [ : ref | ref category ]].
  selector := selectedClassOrMetaClass
  compile: aString
  classified: category
  notifying: aController.
  selector == nil ifTrue: [^ nil].
  contents := aString copy.
 
  self changed: #messageCategoryList. "Because the 'as yet unclassified' might just appear."
  self changed: #messageList. "Because we have code-dependent list formatting by now such as #isDeprecated."
 
  selector ~~ selectedMessageName
  ifTrue:
  [category = ClassOrganizer nullCategory
  ifTrue: [self changed: #classSelectionChanged.
  self changed: #classList.
  self messageCategoryListIndex: 1].
  self setClassOrganizer.  "In case organization not cached"
  (oldMessageList includes: selector)
  ifFalse: [self changed: #messageList].
  self messageListIndex: (self messageList indexOf: selector)].
  ^ selector!

Item was added:
+ ----- Method: Browser>>dropOnClassList:at:shouldCopy: (in category 'drag and drop') -----
+ dropOnClassList: method at: index shouldCopy: shouldCopy
+
+ ^ self
+ moveMethod: method
+ shouldCopy: shouldCopy
+ class: (self environment classNamed: (self hierarchicalClassList at: index) withBlanksTrimmed)
+ category: [:sourceClass :areClassesRelated |
+ areClassesRelated
+ ifTrue: [sourceClass whichCategoryIncludesSelector: method selector]
+ ifFalse: [nil]]!

Item was removed:
- ----- Method: Browser>>dropOnMessageCategories:at: (in category 'drag and drop') -----
- dropOnMessageCategories: method at: index
-
- | sourceClass destinationClass category copy |
- copy := Sensor shiftPressed.
- (method isKindOf: CompiledMethod)
- ifFalse:[^self inform: 'Can only drop methods'].
- sourceClass := method methodClass.
- destinationClass := self selectedClassOrMetaClass.
- sourceClass == destinationClass ifTrue:[
- category := self messageCategoryList at: index.
- category = ClassOrganizer allCategory ifTrue: [^false].
- destinationClass organization classify: method selector  under: category suppressIfDefault: false logged: true.
- self changed: #messageCategoryList.
- self changed: #messageList.
- ^true ].
- (copy
- or: [ (destinationClass inheritsFrom: sourceClass)
- or: [ (sourceClass inheritsFrom: destinationClass)
- or: [ sourceClass theNonMetaClass == destinationClass theNonMetaClass ] ] ])
- ifFalse: [
- (self confirm: (
- 'Classes "{1}" and "{2}" are unrelated.{3}Are you sure you want to move this method?'
- format: { sourceClass. destinationClass. Character cr }))
- ifFalse: [ ^false ] ].
- destinationClass
- compile: method getSource
- classified: (self messageCategoryList at: index)
- withStamp: method timeStamp
- notifying: nil.
- copy ifFalse: [
- sourceClass removeSelector: method selector ].
- ^true!

Item was added:
+ ----- Method: Browser>>dropOnMessageCategories:at:shouldCopy: (in category 'drag and drop') -----
+ dropOnMessageCategories: method at: index shouldCopy: shouldCopy
+
+ ^ self
+ moveMethod: method
+ shouldCopy: shouldCopy
+ class: self selectedClassOrMetaClass
+ category: (self messageCategoryList at: index)!

Item was changed:
  ----- Method: Browser>>dropOnSystemCategories:at: (in category 'drag and drop') -----
  dropOnSystemCategories: aClass at: index
+
  | category |
+ aClass isBehavior ifFalse: [^ self inform: 'Can only drop classes' translated].
- (aClass isBehavior) ifFalse:[^self inform: 'Can only drop classes'].
  category := self systemCategoryList at: index.
+ self selectedEnvironment organization classify: aClass instanceSide name under: category.
- self selectedEnvironment organization classify: aClass instanceSide name  under: category.
  self changed: #systemCategoryList.
  self changed: #classList.
+ ^ true!
- ^true!

Item was changed:
  ----- Method: Browser>>mainMessageListMenu: (in category 'message functions') -----
  mainMessageListMenu: aMenu
  <messageListMenuShifted: false>
  ^ aMenu addList: #(
  ('what to show...' offerWhatToShowMenu)
  ('toggle break on entry' toggleBreakOnEntry)
  -
  ('browse full (b)' browseMethodFull)
+ ('browse hierarchy (h)' classHierarchy)
- ('browse hierarchy (h)' browseClassHierarchy)
  ('browse protocol (p)' browseFullProtocol)
  -
  ('fileOut' fileOutMessage)
  ('printOut' printOutMessage)
  ('copy selector (c)' copySelector)
  ('copy reference (C)' copyReference)
  -
  ('senders of... (n)' browseSendersOfMessages)
  ('implementors of... (m)' browseMessages)
  ('inheritance (i)' methodHierarchy)
  ('versions (v)' browseVersions)
  -
  ('references... (r)' browseVariableReferences)
  ('assignments... (a)' browseVariableAssignments)
  ('class refs (N)' browseClassRefs)
  -
  ('remove method (x)' removeMessage)
  ('explore method' exploreMethod)
  ('inspect method' inspectMethod));
  yourself
  !

Item was changed:
  ----- Method: Browser>>messageHelpAt: (in category 'message list') -----
  messageHelpAt: anIndex
  "Show the first n lines of the sources code of the selected message."
 
+ | messageName iconHelp selector method |
- | iconHelp selector method |
  Preferences balloonHelpInMessageLists ifFalse: [^ nil].
+ messageName := self messageList at: anIndex ifAbsent: [^ nil].
- self messageList size < anIndex ifTrue: [^ nil].
 
- "Items in the message list can be formatted texts."
  self flag: #refactor.
+ selector := Symbol lookup: messageName asString.
- selector := Symbol lookup: (self messageList at: anIndex) asString.
  selector ifNil: [^ nil].
 
  method := self selectedClassOrMetaClass compiledMethodAt: selector ifAbsent: [^ nil].
  iconHelp := (self messageIconHelpFor: method selector) ifNotEmpty: [:t |
  t , Character cr, Character cr].
 
  ^ iconHelp asText
  append: (self messageHelpForMethod: method);
  yourself!

Item was added:
+ ----- Method: Browser>>moveMethod:shouldCopy:class:category: (in category 'drag and drop') -----
+ moveMethod: method shouldCopy: shouldCopy class: destinationClass category: categoryOrBlock
+
+ | sourceClass areClassesRelated category |
+ (method isKindOf: CompiledMethod)
+ ifFalse: [^ self inform: 'Can only drop methods' translated].
+ sourceClass := method methodClass.
+ areClassesRelated := (destinationClass inheritsFrom: sourceClass)
+ or: [ (sourceClass inheritsFrom: destinationClass) ]
+ or: [ sourceClass theNonMetaClass == destinationClass theNonMetaClass ].
+ (shouldCopy or: [areClassesRelated]) ifFalse: [
+ (self confirm: ('Classes "{1}" and "{2}" are unrelated.\Are you sure you want to move this method?' withCRs translated
+ format: { sourceClass. destinationClass }))
+ ifFalse: [ ^ false ] ].
+ category := categoryOrBlock isBlock
+ ifTrue: [categoryOrBlock value: sourceClass value: areClassesRelated]
+ ifFalse: [categoryOrBlock].
+ sourceClass == destinationClass
+ ifTrue: [
+ category = ClassOrganizer allCategory ifTrue: [^ false].
+ destinationClass organization classify: method selector under: category suppressIfDefault: false logged: true ]
+ ifFalse: [
+ destinationClass
+ compile: method getSource
+ classified: category
+ withStamp: method timeStamp
+ notifying: nil.
+ shouldCopy ifFalse: [
+ sourceClass removeSelector: method selector ] ].
+ "self setClass: destinationClass selector: method selector."
+ ^ true!

Item was changed:
  ----- Method: Browser>>renameClass (in category 'class functions') -----
  renameClass
  | oldName newName obs oldBinding |
  self hasClassSelected ifFalse: [^ self].
  self okToChange
  ifFalse: [^ self].
  oldName := self selectedClass name.
  newName := self request: 'Please type new class name' initialAnswer: oldName.
  newName = ''
  ifTrue: [^ self].
  "Cancel returns ''"
  newName := newName asSymbol.
  newName = oldName
  ifTrue: [^ self].
  (self selectedClass environment includesKey: newName)
  ifTrue: [^ self error: newName , ' already exists'].
  oldBinding := self selectedClass environment declarationOf: oldName.
  [self selectedClass rename: newName]
+ on: Notification
+ do: [:ex | self inform: ex messageText].
- on: RemarkNotification
- do: [:ex | self inform: ex messageText. ex resume].
  selectedClassName := newName.
  self changed: #classList.
  obs := self systemNavigation allCallsOn: oldBinding.
  obs isEmpty
  ifFalse: [self systemNavigation
  browseMessageList: obs
  name: 'Obsolete References to ' , oldName
  autoSelect: oldName].
  self selectClassNamed: newName.!

Item was changed:
  ----- Method: Browser>>selectClassNamed: (in category 'class list') -----
  selectClassNamed: aSymbolOrString
  | className currentMessageCategoryName currentMessageName |
 
+ currentMessageCategoryName := [self selectedMessageCategoryName] ifError: [nil].
+ currentMessageName := [self selectedMessageName] ifError: [nil].
- currentMessageCategoryName := [self selectedMessageCategoryName]
- on: Error
- do: [:ex| ex return: nil].
- currentMessageName := [self selectedMessageName]
- on: Error
- do: [:ex| ex return: nil].
 
  selectedClassName := aSymbolOrString ifNotNil: [ aSymbolOrString asSymbol ].
  self setClassOrganizer.
  self setClassDefinition.
 
  "Try to reselect the category and/or selector if the new class has them."
+ selectedMessageCategoryName := (self messageCategoryList includes: currentMessageCategoryName)
- selectedMessageCategoryName :=(self messageCategoryList includes: currentMessageCategoryName)
  ifTrue: [currentMessageCategoryName]
  ifFalse: [nil].
  selectedMessageName := (self messageList includes: currentMessageName)
  ifTrue: [currentMessageName]
  ifFalse: [nil].
 
  self hasMessageSelected ifTrue:
  [self editSelection: #editMessage] ifFalse:
  [self hasMessageCategorySelected ifTrue:
  [self editSelection: #newMessage] ifFalse:
  [self classCommentIndicated
  ifTrue: [self editSelection: #editComment]
  ifFalse: [self editSelection: (self hasClassSelected not
  ifTrue: [(metaClassIndicated or: [ self hasSystemCategorySelected not ])
  ifTrue: [#none]
  ifFalse: [#newClass]]
  ifFalse: [#editClass])]]].
  contents := nil.
  self selectedClass isNil
  ifFalse: [className := self selectedClass name.
  (RecentClasses includes: className)
  ifTrue: [RecentClasses remove: className].
  RecentClasses addFirst: className.
  RecentClasses size > 16
  ifTrue: [RecentClasses removeLast]].
  self changed: #classSelectionChanged.
  self changed: #classCommentText.
  self changed: #classListIndex. "update my selection"
  self changed: #messageCategoryList.
  self changed: #messageList.
  self changed: #relabel.
  self changed: #selectedSystemCategoryName.
  self contentsChanged!

Item was added:
+ ----- Method: Browser>>wantsClassListDrop: (in category 'drag and drop') -----
+ wantsClassListDrop: anObject
+
+ ^ anObject isCompiledMethod!

Item was changed:
  ----- Method: ChangeList>>scanCategory (in category 'scanning') -----
  scanCategory  
  "Scan anything that involves more than one chunk; method name is historical only"
 
+ | itemPosition item tokens stamp anIndex |
- | itemPosition item tokens stamp anIndex class meta |
  itemPosition := file position.
  item := file nextChunk.
 
  ((item includesSubstring: 'commentStamp:')
  or: [(item includesSubstring: 'methodsFor:')
+ or: [item endsWith: 'reorganize']]) ifFalse:
- or: [(item includesSubstring: 'classDefinition:')
- or: [item endsWith: 'reorganize']]]) ifFalse:
  ["Maybe a preamble, but not one we recognize; bail out with the preamble trick"
  ^ self addItem: (ChangeRecord new file: file position: itemPosition type: #preamble)
  text: ('preamble: ' , item contractTo: 50)].
 
  tokens := Scanner new scanTokens: item.
  tokens size >= 3 ifTrue:
  [stamp := ''.
  anIndex := tokens indexOf: #stamp: ifAbsent: [nil].
  anIndex ifNotNil: [stamp := tokens at: (anIndex + 1)].
 
  tokens second == #methodsFor:
  ifTrue: [^ self scanCategory: tokens third class: tokens first
  meta: false stamp: stamp].
  tokens third == #methodsFor:
  ifTrue: [^ self scanCategory: tokens fourth class: tokens first
  meta: true stamp: stamp]].
 
  tokens second == #commentStamp:
  ifTrue:
  [stamp := tokens third.
  self addItem:
  (ChangeRecord new file: file position: file position type: #classComment
  class: tokens first category: nil meta: false stamp: stamp)
  text: 'class comment for ' , tokens first,
   (stamp isEmpty ifTrue: [''] ifFalse: ['; ' , stamp]).
  file nextChunk.
  ^ file skipStyleChunk].
-
- tokens first == #classDefinition:
- ifTrue:
- [class := tokens second.
- meta := tokens size >= 3 and: [tokens third = 'class'].
- stamp := ''.
- self addItem:
- (ChangeRecord new file: file position: file position type: #classDefinition
- class: class category: nil meta: meta stamp: stamp)
- text: 'class definition for ' , class,
-  (stamp isEmpty ifTrue: [''] ifFalse: ['; ' , stamp]).
- file nextChunk.
- ^ file skipStyleChunk].
 
  self assert: tokens last == #reorganize.
  self addItem:
  (ChangeRecord new
  file: file position: file position type: #reorganize
  class: tokens first category: nil meta: false stamp: stamp)
  text: 'organization for ' , tokens first, (tokens second == #class ifTrue: [' class'] ifFalse: ['']).
  file nextChunk!

Item was changed:
  ----- Method: ChangeList>>scanFile:from:to: (in category 'scanning') -----
  scanFile: aFile from: startPosition to: stopPosition
 
  file := aFile.
  changeList := OrderedCollection new.
  list := OrderedCollection new.
  listIndex := 0.
  file position: startPosition.
  'Scanning ', aFile localName, '...'
  displayProgressFrom: startPosition to: stopPosition
  during: [:bar | | prevChar itemPosition item |
  [file position < stopPosition]
  whileTrue:
  [bar value: file position.
  [file atEnd not and: [file peek isSeparator]]
  whileTrue: [prevChar := file next].
  (file peekFor: $!!)
  ifTrue:
  [(prevChar = Character cr or: [prevChar = Character lf])
  ifTrue: [self scanCategory]]
  ifFalse:
  [itemPosition := file position.
  item := file nextChunk.
  file skipStyleChunk.
  item size > 0 ifTrue:
+ [self addItem: (ChangeRecord new file: file position: itemPosition type: #doIt)
+ text: 'do it: ' , (item contractTo: 50)]]]].
- [(item beginsWith: '----')
- ifTrue:
- [self addItem: (ChangeRecord new
- file: file position: itemPosition type: #misc)
- text: 'misc: ' , (item contractTo: 50)]
- ifFalse:
- [self addItem: (ChangeRecord new
- file: file position: itemPosition type: #doIt)
- text: 'do it: ' , (item contractTo: 50)]]]]].
  listSelections := Array new: list size withAll: false!

Item was changed:
  ----- Method: CodeHolder>>messageListKey:from: (in category 'message list menu') -----
  messageListKey: aChar from: view
  "Respond to a Command key.  I am a model with a code pane, and I also
  have a listView that has a list of methods.  The view knows how to get
  the list and selection."
  | sel class |
  aChar == $D ifTrue: [^ self toggleDiffing].
  sel := self selectedMessageName.
  aChar == $m ifTrue:  "These next two put up a type in if no message selected"
  [^ self useSelector: sel orGetSelectorAndSendQuery: #browseAllImplementorsOf: to: self ].
  aChar == $n ifTrue:
  [^ self useSelector: sel orGetSelectorAndSendQuery: #browseAllCallsOn: to: self ].
  aChar == $d ifTrue: [^ self removeMessageFromBrowser].
  "The following require a class selection"
  (class := self selectedClassOrMetaClass) ifNil: [^ self arrowKey: aChar from: view].
  aChar == $b ifTrue: [^ ToolSet browse: class selector: sel].
  aChar == $N ifTrue: [^ self browseClassRefs].
  aChar == $i ifTrue: [^ self methodHierarchy].
+ aChar == $h ifTrue: [^ self classHierarchy].
- aChar == $h ifTrue: [^ self browseClassHierarchy].
  aChar == $p ifTrue: [^ self browseFullProtocol].
  aChar == $r ifTrue: [^ self browseVariableReferences].
  aChar == $a ifTrue: [^ self browseVariableAssignments].
  (aChar == $Y and: [self canShowMultipleMessageCategories])
  ifTrue: [^ self showHomeCategory].
  "The following require a method selection"
  sel ifNotNil:
  [aChar == $o ifTrue: [^ self fileOutMessage].
  aChar == $c ifTrue: [^ self copySelector].
  aChar == $v ifTrue: [^ self browseVersions].
  aChar == $x ifTrue: [^ self removeMessage].
  aChar == $C ifTrue: [ self copyReference ]].
  ^ self arrowKey: aChar from: view!

Item was changed:
  ----- Method: CodeHolder>>optionalButtonPairs (in category 'controls') -----
  optionalButtonPairs
  "Answer a tuple (formerly pairs) defining buttons, in the format:
  button label
  selector to send
  help message"
 
  | aList |
 
  aList := #(
  ('browse' browseMethodFull 'view this method in a browser')
  ('senders' browseSendersOfMessages 'browse senders of...')
  ('implementors' browseMessages 'browse implementors of...')
  ('versions' browseVersions 'browse versions')),
 
  (Preferences decorateBrowserButtons
  ifTrue:
  [{#('inheritance' methodHierarchy 'browse method inheritance
  green: sends to super
  tan: has override(s)
  mauve: both of the above
  pink: is an override but doesn''t call super
  pinkish tan: has override(s), also is an override but doesn''t call super' )}]
  ifFalse:
  [{#('inheritance' methodHierarchy 'browse method inheritance')}]),
 
  #(
+ ('hierarchy' classHierarchy 'browse class hierarchy')
- ('hierarchy' browseClassHierarchy 'browse class hierarchy')
  ('vars' browseVariableReferences 'references...')).
 
  ^ aList!

Item was removed:
- ----- Method: Debugger>>browseClassHierarchy (in category 'toolbuilder') -----
- browseClassHierarchy
- "Create and schedule a class list browser on the receiver's hierarchy."
-
- (self selectedMessageName = #doesNotUnderstand: and: [ self selectedClassOrMetaClass = Object ])
- ifTrue:
- [ self systemNavigation
- spawnHierarchyForClass: self receiverClass
- selector: self selectedMessageName ]
- ifFalse: [ super browseClassHierarchy ]!

Item was added:
+ ----- Method: Debugger>>classHierarchy (in category 'toolbuilder') -----
+ classHierarchy
+ "Create and schedule a class list browser on the receiver's hierarchy."
+ (self selectedMessageName = #doesNotUnderstand: and: [ self selectedClassOrMetaClass = Object ])
+ ifTrue:
+ [ self systemNavigation
+ spawnHierarchyForClass: self receiverClass
+ selector: self selectedMessageName ]
+ ifFalse: [ super classHierarchy ]!

Item was changed:
  ----- Method: Debugger>>newStack: (in category 'private') -----
  newStack: stack
  | oldStack diff |
  oldStack := contextStack.
  contextStack := stack.
  (oldStack == nil or: [oldStack last ~~ stack last])
  ifTrue: [contextStackList := contextStack collect: [:ctx | ctx printString].
  ^ self].
  "May be able to re-use some of previous list"
  diff := stack size - oldStack size.
  contextStackList := diff <= 0
  ifTrue: [contextStackList copyFrom: 1-diff to: oldStack size]
+ ifFalse: [diff > 1
+ ifTrue: [contextStack collect: [:ctx | ctx printString]]
+ ifFalse: [(Array with: stack first printString) , contextStackList]]!
- ifFalse: [(diff = 1 and: [stack second == oldStack first])
- ifTrue: [contextStackList copyWithFirst: stack first printString]
- ifFalse: [contextStack collect: [:ctx | ctx printString]]]!

Item was changed:
  ----- Method: Debugger>>shiftedContextStackMenu: (in category 'context stack menu') -----
  shiftedContextStackMenu: aMenu
  "Set up the menu appropriately for the context-stack-list, shifted"
  <contextStackMenuShifted: true>
  ^ aMenu addList: #(
+ ('browse class hierarchy' classHierarchy)
- ('browse class hierarchy' browseClassHierarchy)
  ('browse class' browseClass)
  ('implementors of sent messages' browseAllMessages)
  ('change sets with this method' findMethodInChangeSets)
  -
  ('inspect instances' inspectInstances)
  ('inspect subinstances' inspectSubInstances)
  -
  ('revert to previous version' revertToPreviousVersion)
  ('remove from current change set' removeFromCurrentChanges)
  ('revert & remove from changes' revertAndForget));
  yourself
  !

Item was changed:
  ----- Method: DebuggerMethodMap>>rangeForPC:in:contextIsActiveContext: (in category 'source mapping') -----
  rangeForPC: contextsConcretePC in: method contextIsActiveContext: contextIsActiveContext
+ "Answer the indices in the source code for the supplied pc. If the context is the active context (is at the hot end of the stack) then its pc is the current pc. But if the context isn't, because it is suspended sending a message, then its current pc is the previous pc."
- "Answer the indices in the source code for the supplied pc.
- If the context is the actve context (is at the hot end of the stack)
- then its pc is the current pc.  But if the context isn't, because it is
- suspended sending a message, then its current pc is the previous pc."
 
+ | pc i end sortedMap |
- | pc i end |
  pc := method abstractPCForConcretePC: (contextIsActiveContext
+ ifTrue: [contextsConcretePC]
+ ifFalse: [(method pcPreviousTo: contextsConcretePC)
+ ifNil: [contextsConcretePC]]).
+ (self abstractSourceMapForMethod: method)
+ at: pc
+ ifPresent: [:range | ^ range].
+ sortedMap := self sortedSourceMapForMethod: method.
+ sortedMap isEmpty ifTrue: [^ 1 to: 0].
+ i := sortedMap
+ findBinaryIndex: [:assoc | pc - assoc key]
+ ifNone: [:lower :upper | upper].
+ i < 1 ifTrue: [^ 1 to: 0].
+ i > sortedMap size ifTrue: [
+ end := sortedMap inject: 0 into: [:prev :this |
+ prev max: this value last].
+ ^ end + 1 to: end].
+ ^ (sortedMap at: i) value!
- ifTrue: [contextsConcretePC]
- ifFalse: [(method pcPreviousTo: contextsConcretePC)
- ifNotNil: [:prevpc| prevpc]
- ifNil: [contextsConcretePC]]).
- (self abstractSourceMap includesKey: pc) ifTrue:
- [^self abstractSourceMap at: pc].
- sortedSourceMap ifNil:
- [sortedSourceMap := self abstractSourceMap associations
- replace: [ :each | each copy ];
- sort].
- sortedSourceMap isEmpty ifTrue: [^1 to: 0].
- i := sortedSourceMap findNearbyBinaryIndex: [:assoc| pc - assoc key].
- i < 1 ifTrue: [^1 to: 0].
- i > sortedSourceMap size ifTrue:
- [end := sortedSourceMap inject: 0 into:
- [:prev :this | prev max: this value last].
- ^end+1 to: end].
- ^(sortedSourceMap at: i) value
-
- "| method source scanner map |
- method := DebuggerMethodMap compiledMethodAt: #rangeForPC:in:contextIsActiveContext:.
- source := method getSourceFromFile asString.
- scanner := InstructionStream on: method.
- map := method debuggerMap.
- Array streamContents:
- [:ranges|
- [scanner atEnd] whileFalse:
- [| range |
- range := map rangeForPC: scanner pc in: method contextIsActiveContext: true.
- ((map abstractSourceMap includesKey: scanner abstractPC)
-  and: [range first ~= 0]) ifTrue:
- [ranges nextPut: (source copyFrom: range first to: range last)].
- scanner interpretNextInstructionFor: InstructionClient new]]"!

Item was added:
+ ----- Method: DebuggerMethodMap>>sortedSourceMap (in category 'private') -----
+ sortedSourceMap
+
+ ^ sortedSourceMap ifNil: [
+ sortedSourceMap := self abstractSourceMap associations
+ replace: [:each | each copy];
+ sort]!

Item was added:
+ ----- Method: DebuggerMethodMap>>sortedSourceMapForMethod: (in category 'source mapping') -----
+ sortedSourceMapForMethod: aCompiledMethod
+
+ ^ self sortedSourceMap!

Item was changed:
  ----- Method: DebuggerMethodMapForFullBlockCompiledMethods>>abstractSourceMap (in category 'source mapping') -----
  abstractSourceMap
+
+ ^ self shouldNotImplement!
- self shouldNotImplement!

Item was removed:
- ----- Method: DebuggerMethodMapForFullBlockCompiledMethods>>rangeForPC:in:contextIsActiveContext: (in category 'source mapping') -----
- rangeForPC: contextsConcretePC in: method contextIsActiveContext: contextIsActiveContext
- "Answer the indices in the source code for the supplied pc.
- If the context is the actve context (is at the hot end of the stack)
- then its pc is the current pc.  But if the context isn't, because it is
- suspended sending a message, then its current pc is the previous pc."
-
- | pc i end mapForMethod sortedMap |
- pc := method abstractPCForConcretePC: (contextIsActiveContext
- ifTrue: [contextsConcretePC]
- ifFalse: [(method pcPreviousTo: contextsConcretePC)
- ifNotNil: [:prevpc| prevpc]
- ifNil: [contextsConcretePC]]).
- ((mapForMethod := self abstractSourceMapForMethod: method) includesKey: pc) ifTrue:
- [^mapForMethod at: pc].
- sortedSourceMap ifNil:
- [sortedSourceMap := IdentityDictionary new].
- sortedMap := sortedSourceMap
- at: method
- ifAbsentPut: [mapForMethod associations
- replace: [ :each | each copy ];
- sort].
- sortedMap isEmpty ifTrue: [^1 to: 0].
- i := sortedMap findNearbyBinaryIndex: [:assoc| pc - assoc key].
- i < 1 ifTrue: [^1 to: 0].
- i > sortedMap size ifTrue:
- [end := sortedMap inject: 0 into:
- [:prev :this | prev max: this value last].
- ^end+1 to: end].
- ^(sortedMap at: i) value
-
- "| method source scanner map |
- method := DebuggerMethodMapForFullBlockCompiledMethods compiledMethodAt: #rangeForPC:in:contextIsActiveContext:.
- source := method getSourceFromFile asString.
- scanner := InstructionStream on: method.
- map := method debuggerMap.
- Array streamContents:
- [:ranges|
- [scanner atEnd] whileFalse:
- [| range |
- range := map rangeForPC: scanner pc in: method contextIsActiveContext: true.
- ((map abstractSourceMap includesKey: scanner abstractPC)
-  and: [range first ~= 0]) ifTrue:
- [ranges nextPut: (source copyFrom: range first to: range last)].
- scanner interpretNextInstructionFor: InstructionClient new]]"!

Item was added:
+ ----- Method: DebuggerMethodMapForFullBlockCompiledMethods>>sortedSourceMap (in category 'source mapping') -----
+ sortedSourceMap
+
+ ^ self shouldNotImplement!

Item was added:
+ ----- Method: DebuggerMethodMapForFullBlockCompiledMethods>>sortedSourceMapForMethod: (in category 'source mapping') -----
+ sortedSourceMapForMethod: method
+
+ sortedSourceMap ifNil: [
+ sortedSourceMap := IdentityDictionary new].
+ ^ sortedSourceMap
+ at: method
+ ifAbsentPut: [(self abstractSourceMapForMethod: method) associations
+ replace: [ :each | each copy ];
+ sort]!

Item was changed:
  ----- Method: FileList>>readGraphicContents (in category 'private') -----
  readGraphicContents
  | form maxExtent ext |
+ form := Form fromFileNamed: self fullName.
- form := (Form fromFileNamed: self fullName) asFormOfDepth: Display depth.
  maxExtent := lastGraphicsExtent := self availableGraphicsExtent.
  ext := form extent.
  (maxExtent notNil and: [form extent <= maxExtent]) ifFalse: [
  form := form magnify: form boundingBox by: (maxExtent x / form width min: maxExtent y / form height) asPoint smoothing: 3].
  contents :=  ('Image extent: ', ext printString) asText,
  (String with: Character cr),
  (Text string: ' '
  attribute: (TextFontReference toFont:
  (FormSetFont new
  fromFormArray: (Array with: form)
  asciiStart: Character space asInteger
  ascent: form height))).
  brevityState := #graphic.
  ^contents!

Item was changed:
  ----- Method: Inspector>>inspectorKey:from: (in category 'menu commands') -----
  inspectorKey: aChar from: view
  "Respond to a Command key issued while the cursor is over my field list"
 
  aChar == $i ifTrue: [^ self selection inspect].
  aChar == $I ifTrue: [^ self selection explore].
  aChar == $b ifTrue: [^ self browseClass].
+ aChar == $h ifTrue: [^ self classHierarchy].
- aChar == $h ifTrue: [^ self browseClassHierarchy].
  aChar == $c ifTrue: [^ self copyName].
  aChar == $p ifTrue: [^ self browseFullProtocol].
  aChar == $N ifTrue: [^ self browseClassRefs].
  aChar == $t ifTrue: [^ self tearOffTile].
  aChar == $v ifTrue: [^ self viewerForValue].
 
  ^ self arrowKey: aChar from: view!

Item was changed:
  ----- Method: Inspector>>mainFieldListMenu: (in category 'menu commands') -----
  mainFieldListMenu: aMenu
  "Arm the supplied menu with items for the field-list of the receiver"
  <fieldListMenu>
  "gets overriden by subclasses, _whithout_ the <fieldListMenu>"
  aMenu addStayUpItemSpecial.
 
  aMenu addList: #(
  ('inspect (i)' inspectSelection)
  ('explore (I)' exploreSelection)).
 
  self addCollectionItemsTo: aMenu.
 
  aMenu addList: #(
  -
  ('method refs to this inst var' referencesToSelection)
  ('methods storing into this inst var' defsOfSelection)
  ('objects pointing to this value' objectReferencesToSelection)
  ('chase pointers' chasePointers)
  ('explore pointers' explorePointers)
  -
  ('browse full (b)' browseClass)
+ ('browse hierarchy (h)' classHierarchy)
- ('browse hierarchy (h)' browseClassHierarchy)
  ('browse protocol (p)' browseFullProtocol)
  -
  ('references... (r)' browseVariableReferences)
  ('assignments... (a)' browseVariableAssignments)
  ('class refs (N)' browseClassRefs)
  -
  ('copy name (c)' copyName)
  ('basic inspect' inspectBasic)).
 
  Smalltalk isMorphic ifTrue:
  [aMenu addList: #(
  -
  ('tile for this value (t)' tearOffTile)
  ('viewer for this value (v)' viewerForValue))].
 
  ^ aMenu
 
 
  " -
  ('alias for this value' aliasForValue)
  ('watcher for this slot' watcherForSlot)"
 
  !

Item was removed:
- ----- Method: MessageNames>>postAcceptBrowseFor: (in category 'morphic ui') -----
- postAcceptBrowseFor: anotherModel
-
- self searchString: anotherModel searchString.!

Item was removed:
- ----- Method: MessageSet>>deleteAllFromMessageList: (in category 'message functions') -----
- deleteAllFromMessageList: aCollection
- "Delete the given messages from the receiver's message list"
- | currIdx |
- currIdx := self messageListIndex.
- messageList := messageList copyWithoutAll: aCollection.
- messageList ifNotEmpty: [self messageListIndex: {currIdx. messageList size.} min]!

Item was changed:
  ----- Method: MessageSet>>mainMessageListMenu: (in category 'message list') -----
  mainMessageListMenu: aMenu
  "Answer the message-list menu"
  <messageListMenuShifted: false>
  aMenu addList: #(
  ('what to show...' offerWhatToShowMenu)
  ('toggle break on entry' toggleBreakOnEntry)
  -
  ('browse full (b)' browseMethodFull)
+ ('browse hierarchy (h)' classHierarchy)
- ('browse hierarchy (h)' browseClassHierarchy)
  ('browse protocol (p)' browseFullProtocol)
  -
  ('fileOut' fileOutMessage)
  ('printOut' printOutMessage)
  ('copy selector (c)' copySelector)
  ('copy reference (C)' copyReference)
  -
  ('senders of... (n)' browseSendersOfMessages)
  ('implementors of... (m)' browseMessages)
  ('inheritance (i)' methodHierarchy)
  ('versions (v)' browseVersions)
  -
  ('references... (r)' browseVariableReferences)
  ('assignments... (a)' browseVariableAssignments)
  ('class refs (N)' browseClassRefs)
  -
  ('remove method (x)' removeMessage)
  ('explore method' exploreMethod)
  ('inspect method' inspectMethod)).
  ^ aMenu!

Item was removed:
- ----- Method: MessageTrace>>deleteAllFromMessageList: (in category 'building') -----
- deleteAllFromMessageList: aCollection
- "Delete the given messages from the receiver's message list"
-
- | newAutoSelectStrings newMessageSelections newSize set |
- newSize := self messageList size - aCollection size.
- newAutoSelectStrings := OrderedCollection new: newSize.
- newMessageSelections := OrderedCollection new: newSize.
- set := aCollection asSet.
- self messageList withIndexDo: [:each :index |
- (set includes: each) ifFalse:
- [newAutoSelectStrings add: (autoSelectStrings at: index).
- newMessageSelections add: (messageSelections at: index)]].
- super deleteAllFromMessageList: aCollection.
- autoSelectStrings := newAutoSelectStrings.
- messageSelections := newMessageSelections.
- anchorIndex ifNotNil:
- [ anchorIndex := anchorIndex min: messageList size ]!

Item was changed:
  ----- Method: MessageTrace>>removeMessageFromBrowser (in category 'building') -----
  removeMessageFromBrowser
  | indexToSelect |
  "Try to keep the same selection index."
  indexToSelect := (messageSelections indexOf: true) max: 1.
+ self selectedMessages do: [ :eachMethodReference | self deleteFromMessageList: eachMethodReference ].
- self deleteAllFromMessageList: self selectedMessages.
  self deselectAll.
  messageSelections ifNotEmpty:
  [ messageSelections
  at: (indexToSelect min: messageSelections size)  "safety"
  put: true ].
  anchorIndex := indexToSelect min: messageSelections size.
  self
  messageListIndex: anchorIndex ;
  reformulateList!

Item was changed:
  ----- Method: ObjectExplorer>>browseClassHierarchy (in category 'menus - actions') -----
  browseClassHierarchy
  "Create and schedule a class list browser on the receiver's hierarchy."
 
  self systemNavigation
  spawnHierarchyForClass: self selectedClass
+ selector: nil
+ !
- selector: nil.!

Item was removed:
- ----- Method: StringHolder>>browseClassHierarchy (in category '*Tools') -----
- browseClassHierarchy
- "Create and schedule a class list browser on the receiver's hierarchy."
-
- self systemNavigation
- spawnHierarchyForClass: self selectedClassOrMetaClass "OK if nil"
- selector: self selectedMessageName!

Item was added:
+ ----- Method: StringHolder>>classHierarchy (in category '*Tools') -----
+ classHierarchy
+ "Create and schedule a class list browser on the receiver's hierarchy."
+
+ self systemNavigation
+ spawnHierarchyForClass: self selectedClassOrMetaClass "OK if nil"
+ selector: self selectedMessageName
+ !

Item was changed:
  ----- Method: StringHolder>>messageListKey:from: (in category '*Tools') -----
  messageListKey: aChar from: view
  "Respond to a Command key.  I am a model with a code pane, and I also
  have a listView that has a list of methods.  The view knows how to get
  the list and selection."
 
  | sel class |
  aChar == $D ifTrue: [^ self toggleDiffing].
 
  sel := self selectedMessageName.
  aChar == $m ifTrue:  "These next two put up a type in if no message selected"
  [^ self useSelector: sel orGetSelectorAndSendQuery: #browseAllImplementorsOf: to: self systemNavigation].
  aChar == $n ifTrue:
  [^ self useSelector: sel orGetSelectorAndSendQuery: #browseAllCallsOn: to: self systemNavigation].
 
  "The following require a class selection"
  (class := self selectedClassOrMetaClass) ifNil: [^ self arrowKey: aChar from: view].
  aChar == $b ifTrue: [^ ToolSet browse: class selector: sel].
  aChar == $N ifTrue: [^ self browseClassRefs].
  aChar == $i ifTrue: [^ self methodHierarchy].
+ aChar == $h ifTrue: [^ self classHierarchy].
- aChar == $h ifTrue: [^ self browseClassHierarchy].
  aChar == $p ifTrue: [^ self browseFullProtocol].
 
  "The following require a method selection"
  sel ifNotNil:
  [aChar == $o ifTrue: [^ self fileOutMessage].
  aChar == $c ifTrue: [^ self copySelector].
  aChar == $C ifTrue: [^ self copyReference].
  aChar == $v ifTrue: [^ self browseVersions].
  aChar == $x ifTrue: [^ self removeMessage]].
 
  ^ self arrowKey: aChar from: view!

Item was changed:
  ----- Method: VersionsBrowser class>>browseMethod: (in category 'instance creation') -----
  browseMethod: aCompiledMethod
 
+ ^ (self browseVersionsForClass: aCompiledMethod methodClass selector: aCompiledMethod selector)
+ selectMethod: aCompiledMethod;
- ^ (self browseVersionsOf: aCompiledMethod)
- ifNotNil: [:browser |
- browser selectMethod: aCompiledMethod];
  yourself!

Item was removed:
- ----- Method: VersionsBrowser class>>browseVersionsOf: (in category 'instance creation') -----
- browseVersionsOf: aCompiledMethod
-
- | methodClass methodSelector |
- methodClass := aCompiledMethod methodClass.
- methodSelector := aCompiledMethod selector.
- ^ self
- browseVersionsOf: aCompiledMethod
- class: methodClass
- meta: methodClass isMeta
- category: (methodClass organization categoryOfElement: methodSelector)
- selector: methodSelector!