Contents
Next

A Case Study in Component Development


This track describes the development of a reuseable list view that displays a hierarchical structure. The view is similar to a ListView, but it gives the user the option to show or to hide the subitems of an item. This feature is useful to display a class hierarchy or a folder hierarchy.

Here is a screenshot of the view that we will develop:

A Hierarchy View

The change set for this example is TreeView1.1.cs.

Our first attempt is very simple: We use a PluggableListView to display a list of indented items and implement all tree-related features in the model. The model itself is a subclass of Model:

Model subclass: #HierarchicalListDemo1
       instanceVariableNames: 'collectionOfObjects level selectionIdx'
       classVariableNames: ''
       poolDictionaries: ''
       category: 'MVCTutorial-Components'

The instance variables are used as follows:

As usual, we define a class method to create and to open a window:

open
   "HierarchicalListDemo1 open"
      | topView model listView |
  model := self new.
  topView := StandardSystemView new
              label: 'Hierarchical List'.
  topView model: model.
  topView borderWidth: 1.
  listView := PluggableListView
                on: model
                list: #getClassesList
                selected: #getClassSelection
                changeSelected: #notifyClassSelection:
                menu: #getMenu:
                keystroke: nil.

  listView borderWidth: 1.
  topView addSubView: listView.
  topView controller open.

in HierarchicalListDemo1, an instance method is needed to initialize all three instance variables of the model:

initialize

  collectionOfObjects := Array with: Object.
  level := RunArray new: 1 withAll: 0.
  selectionIdx := 0.

This message initialize is sent once when an instance of HierarchicalListDemo1 is created with the class method new.

To support the list view, we need the four methods that are mentioned in the ListView creation message:

getClassesList

   ^collectionOfObjects
       with: level
       collect: [:cl :lv | (String new: lv*2 withAll: $ ), cl name].

This method takes the collection of classes and the collection of hierarchy level numbers to create a collection of suitably indented strings. The values in level are used to compute the number of indentation spaces.

getClassSelection

   ^selectionIdx
notifyClassSelection: idx

  selectionIdx := idx.

A menu is only provided when an item is selected. It offers two options:

getMenu: aCustomMenu
  selectionIdx = 0
     ifTrue: [^nil].

  aCustomMenu
       add: 'expand' target: self selector: #expand: argument: selectionIdx;
       add: 'collapse' target: self selector: #collapse: argument: selectionIdx.
   ^aCustomMenu

To implement the menu options, we have to implement some simple manipulations with the collections collectionOfObjects and level. For now, we write mehtods that can work with classes, but are not general enough to be used for other hierarchical structures:

The method expand: does nothing for an item that is already expanded. For an item that is not expanded, the method computes the sorted array of its subclasses and rebuilds the collections collectionOfObjects and level. Finally, the method sends two changed: messages to itself to inform its dependent views that something has changed.

expand: idx
   | cls subclasses currentLevel |
  cls := collectionOfObjects at: idx.
  currentLevel := level at: idx.
  (idx < collectionOfObjects size
        and: [(level at: idx + 1) > currentLevel])
    ifTrue: [^self].

  subclasses := cls subclasses 
                     sort: [:cl1 :cl2 | cl1 name < cl2 name].
  collectionOfObjects := (collectionOfObjects copyFrom: 1 to: idx),
                           subclasses,
                           (collectionOfObjects
                                 copyFrom: idx + 1
                                 to: collectionOfObjects size).
  level := (level copyFrom: 1 to: idx),
                 (RunArray new: subclasses size withAll: currentLevel + 1),
                 (level copyFrom: idx + 1 to: level size).
  self changed: #getClassesList;
       changed: #getClassSelection.

The method collapse: does nothing for an item that is not followed by items of a greater hierarchy level index. For an item that is followed by subitems, the method counts the number of subitems to be removed and uses the count to rebuild the collections collectionOfObjects and level. Finally, the method sends two changed: messages to itself to inform its dependent views that something has changed.

collapse: idx
   |  currentLevel levelOfNextItem runLength |
  currentLevel := level at: idx.
  idx = collectionOfObjects size ifTrue: [^self].
  levelOfNextItem := level at: idx + 1.
  currentLevel = levelOfNextItem
    ifTrue: [^self].

  runLength := self numberOfSubElementsFrom: idx
                    level: currentLevel. 
  collectionOfObjects := (collectionOfObjects copyFrom: 1 to: idx),
                           (collectionOfObjects
                                      copyFrom: idx + runLength + 1
                                      to: collectionOfObjects size).
  level := (level copyFrom: 1 to: idx),
                  (level copyFrom: idx + runLength + 1
                         to: level size).
  self changed: #getClassesList;
       changed: #getClassSelection.

The method collapse: uses a supportive method to compute the number of items to be removed. To perform that computation, we use the values in the collection level. Here we profit from the use of a RunArray: For a given collection index idx, the method runLengthAt: idx answers the number of consecutive collection elements that have the value level at: idx. With this information, we can quickly jump over a larger number of subitems that do not have shown subitems in turn.

numberOfSubElementsFrom: idx level: currentLevel
   | cnt pos size rl |
  cnt := 0.
  pos := idx + 1.
  size := collectionOfObjects size.
  [pos <= size and: [(level at: pos) > currentLevel]]
    whileTrue:
      [rl := level runLengthAt: pos.
       pos := pos + rl.
       cnt := cnt + rl].
  ^cnt

When you play with this simple version for some time, you will soon find that some things should be better.


Contents
Next