[FIX] Browser hierarchy and Popup segmentation

John Duncan jddst19+ at pitt.edu
Sun Aug 8 21:42:18 UTC 1999


I'm not sure if these fixes have been posted yet, but I've found two
bugs that needed some fixing.

Browser hierarchy:

If you select a message and say "Browse hierarchy", a hierarchy will
open up set to the correct selector index in the wrong category. This
was caused by the browser not remembering that it adds one to the
index because of the --all-- category. I fixed that here:

-- cut -- [more follows]

'From Squeak 2.3 of January 14, 1999 on 8 August 1999 at 4:21:18 pm'!

!Browser methodsFor: 'class functions' stamp: 'JDD 8/8/1999 16:20'!
spawnHierarchy
 "Create and schedule a new class hierarchy browser on the currently
selected class or meta."
 | newBrowser aSymbol aBehavior messageCatIndex |
 classListIndex = 0 ifTrue: [^ self].
 newBrowser _ HierarchyBrowser new initHierarchyForClass: self
selectedClass
   meta: self metaClassIndicated.
 (aSymbol _ self selectedMessageName) ifNotNil: [
  aBehavior _ self selectedClassOrMetaClass.
  messageCatIndex _ aBehavior organization numberOfCategoryOfElement:
aSymbol.
  newBrowser messageCategoryListIndex: messageCatIndex + 1.
  newBrowser messageListIndex:
   ((aBehavior organization listAtCategoryNumber: messageCatIndex)
      indexOf: aSymbol)].
 Browser openBrowserView: (newBrowser openSystemCatEditString: nil)
  label: self selectedClassName , ' hierarchy'! !

-- cut --

The big change is in the 5th physical line from the bottom.

PopupMenu segmentation:

If you have a lot of lines in a popup menu, the Popup will attempt to
segment the menu into several parts. The theory was good, but it fails
because the calculation of numLines was flawed. I took it instead as
the number of lines, not the number of pixels divided by a magic
number. This seems to work, though it may not be optimal.

-- cut -- [more follows]

'From Squeak 2.3 of January 14, 1999 on 8 August 1999 at 1:06:23 pm'!

!PopUpMenu methodsFor: 'basic control sequence' stamp: 'JDD 8/8/1999
13:05'!
startUpSegmented: segmentHeight withCaption: captionOrNil at: location
 "This menu is too big to fit comfortably on the screen.
 Break it up into smaller chunks, and manage the relative indices.
 Inspired by a special-case solution by Reinier van Loon."
"
(PopUpMenu labels: (String streamContents: [:s | 1 to: 100 do: [:i | s
print: i; cr]. s skip: -1])
  lines: (5 to: 100 by: 5)) startUpWithCaption: 'Give it a whirl...'.
"
 | nLines nLinesPer allLabels from to subset subLines index |
 frame ifNil: [self computeForm].
 "nLines _ (frame height - 4) // marker height."
 allLabels := labelString findTokens: Character cr asString.
 nLines _ allLabels size.
 lineArray ifNil: [lineArray _ Array new].
 nLinesPer _ segmentHeight // marker height - 3.
 from := 1.
 [ true ] whileTrue:
  [to := (from + nLinesPer) min: nLines.
  subset := allLabels copyFrom: from to: to.
  subset add: (to = nLines ifTrue: ['start over...'] ifFalse:
['more...'])
   before: subset first.
  subLines _ lineArray select: [:n | n >= from] thenCollect: [:n | n -
(from-1) + 1].
  subLines _ (Array with: 1) , subLines.
  index := (PopUpMenu labels: subset asStringWithCr lines: subLines)
startUpWithCaption: captionOrNil at: location.
  index = 1
   ifTrue: [from := to + 1.
     from > nLines ifTrue: [ from := 1 ]]
   ifFalse: [index = 0 ifTrue: [^ 0].
     ^ from + index - 2]]! !

-- cut above --

I also think that the way it lists the categories is not very useful,
because it is trying to eliminate some common categories taken from
object (I imagine in order to clean up the list). I didn't like this
very much because they seem to be used a lot. So I modified Browser to
do it my way. This is entirely optional. I also made it sort the list
with categories containing "ing" toward the top, and everything sorted
alphabetically. There are probably flaws in this code. I encourage
interested parties to see what they think.

-- cut -- [no interesting stuff follows]

'From Squeak 2.3 of January 14, 1999 on 8 August 1999 at 4:21:24 pm'!

!Browser methodsFor: 'message category functions' stamp: 'JDD 8/8/1999
14:26'!
addCategory
 "Present a choice of categories or prompt for a new category name and
add it before the current selection, or at the end if no current
selection"
 | labels reject lines cats menuIndex oldIndex newName |
 self okToChange ifFalse: [^ self].
 classListIndex = 0 ifTrue: [^ self].
 labels _ OrderedCollection with: 'new...'.
 reject _ Set new.
 reject
  addAll: self selectedClassOrMetaClass organization categories;
  add: ClassOrganizer nullCategory;
  add: ClassOrganizer default.
 lines _ OrderedCollection new.
 self selectedClassOrMetaClass allSuperclasses do: [:cls |
  "cls = Object ifFalse: ["
   cats _ cls organization categories reject:
     [:cat | reject includes: cat].
   cats _ cats clone.
   cats sort: [ :s :t |
     (s includesSubString: 'ing')
      ifTrue: [ (t includesSubString: 'ing')
       ifTrue: [ (s < t) ]
       ifFalse: [ true ]]
      ifFalse: [ (t includesSubString: 'ing')
       ifTrue: [ false ]
       ifFalse: [ (s < t) ]]].
   cats isEmpty ifFalse: [
    lines add: labels size.
    labels addAll: cats.
    reject addAll: cats]]. "]."
 newName _ (labels size = 1 or: [
  menuIndex _ (PopUpMenu labelArray: labels lines: lines)
  startUpWithCaption: 'Add Category'.
  menuIndex = 0 ifTrue: [^ self].
  menuIndex = 1])
   ifTrue: [
    self request: 'Please type new category name'
     initialAnswer: 'category name']
   ifFalse: [
    labels at: menuIndex].
 oldIndex _ messageCategoryListIndex.
 newName isEmpty
  ifTrue: [^ self]
  ifFalse: [newName _ newName asSymbol].
 self classOrMetaClassOrganizer
  addCategory: newName
  before: (messageCategoryListIndex = 0
    ifTrue: [nil]
    ifFalse: [self selectedMessageCategoryName]).
 self changed: #messageCategoryList.
 self messageCategoryListIndex:
  (oldIndex = 0
   ifTrue: [self classOrMetaClassOrganizer categories size]
   ifFalse: [oldIndex]).
 self changed: #messageCategoryList.
! !

-- cut above --

I await flames, etc.

-John





More information about the Squeak-dev mailing list