Tools__ObjectModuleInformation.st
author Claus Gittinger <cg@exept.de>
Tue, 20 Oct 2009 10:38:40 +0200
changeset 2629 61f3f3a13b9e
parent 2624 d8957c9cb38c
child 2658 c284507a1279
permissions -rw-r--r--
changed: #doBrowseActionMethod:nameAs: implements: -> includesSelector:

"{ Package: 'stx:libtool2' }"

"{ NameSpace: Tools }"

ToolApplicationModel subclass:#ObjectModuleInformation
	instanceVariableNames:'readOnly listOfModuleNames selectedModuleIndexHolder allModules
		objectHandles showOthers showCObjects showBuiltIn showMethods
		showClassLibs table1VisibleHolder table2VisibleHolder
		selectedInfoIndexHolder canBrowseSelectedModule
		canUnloadSelectedModule classNamesShown classInfoShown
		vmInfoShown canUnloadSelectedModulesPackage
		canBrowseSelectedModulesExtensions canUnloadSelectedDLL'
	classVariableNames:''
	poolDictionaries:''
	category:'Monitors-ST/X'
!

Object subclass:#InfoRow
	instanceVariableNames:'name version date value'
	classVariableNames:''
	poolDictionaries:''
	privateIn:ObjectModuleInformation
!

!ObjectModuleInformation class methodsFor:'documentation'!

documentation
"
    Shows the modules (dll's) of ST/X.
    Both builtIn modules, and dynamically loaded modules are listed.

    [author:]
        Claus Gittinger
"
!

examples
"
  Starting the application:
                                                                [exBegin]
    ObjectModuleInformation open

                                                                [exEnd]
"
! !

!ObjectModuleInformation class methodsFor:'info'!

defaultLabel
    ^ 'Object Module Info'

    "Created: / 05-10-2007 / 11:56:59 / cg"
! !

!ObjectModuleInformation class methodsFor:'interface specs'!

windowSpec
    "This resource specification was automatically generated
     by the UIPainter of ST/X."

    "Do not manually edit this!! If it is corrupted,
     the UIPainter may not be able to read the specification."

    "
     UIPainter new openOnClass:Tools::ObjectModuleInformation andSelector:#windowSpec
     Tools::ObjectModuleInformation new openInterface:#windowSpec
     Tools::ObjectModuleInformation open
    "

    <resource: #canvas>

    ^ 
     #(FullSpec
        name: windowSpec
        window: 
       (WindowSpec
          label: 'ST/X Module & Version Information'
          name: 'ST/X Module & Version Information'
          min: (Point 0 0)
          bounds: (Rectangle 0 0 505 567)
          menu: mainMenu
        )
        component: 
       (SpecCollection
          collection: (
           (MenuPanelSpec
              name: 'ToolBar1'
              layout: (LayoutFrame 0 0 0 0 0 1 40 0)
              menu: toolbarMenu
              textDefault: true
            )
           (VariableVerticalPanelSpec
              name: 'VariableVerticalPanel1'
              layout: (LayoutFrame 0 0 40 0 0 1 0 1)
              component: 
             (SpecCollection
                collection: (
                 (SequenceViewSpec
                    name: 'List1'
                    model: selectedModuleIndexHolder
                    menu: moduleMenu
                    hasHorizontalScrollBar: true
                    hasVerticalScrollBar: true
                    useIndex: true
                    sequenceList: listOfModuleNames
                  )
                 (ViewSpec
                    name: 'Box1'
                    component: 
                   (SpecCollection
                      collection: (
                       (LabelSpec
                          name: 'Label1'
                          layout: (LayoutFrame 0 0 0 0 0 1 30 0)
                          translateLabel: true
                          labelChannel: middleLabelHolder
                          adjust: left
                        )
                       (DataSetSpec
                          name: 'Table1'
                          layout: (LayoutFrame 0 0 30 0 0 1 0 1)
                          visibilityChannel: table1VisibleHolder
                          model: selectedInfoIndexHolder
                          menu: moduleItemMenu
                          hasHorizontalScrollBar: true
                          hasVerticalScrollBar: true
                          dataList: infoTable1ListHolder
                          columnHolder: tableColumns
                          separatorOneDColor: (Color 66.999313344015 66.999313344015 66.999313344015)
                        )
                       (DataSetSpec
                          name: 'Table2'
                          layout: (LayoutFrame 0 0 30 0 0 1 0 1)
                          initiallyInvisible: true
                          visibilityChannel: table2VisibleHolder
                          model: selectedInfoIndexHolder
                          hasHorizontalScrollBar: true
                          hasVerticalScrollBar: true
                          dataList: infoTable2ListHolder
                          columnHolder: tableColumnsForSingleInfo
                          separatorOneDColor: (Color 66.999313344015 66.999313344015 66.999313344015)
                        )
                       )
                     
                    )
                  )
                 )
               
              )
              handles: (Any 0.35195530726257 1.0)
            )
           )
         
        )
      )
! !

!ObjectModuleInformation class methodsFor:'menu specs'!

mainMenu
    "This resource specification was automatically generated
     by the MenuEditor of ST/X."

    "Do not manually edit this!! If it is corrupted,
     the MenuEditor may not be able to read the specification."

    "
     MenuEditor new openOnClass:Tools::ObjectModuleInformation andSelector:#mainMenu
     (Menu new fromLiteralArrayEncoding:(Tools::ObjectModuleInformation mainMenu)) startUp
    "

    <resource: #menu>

    ^ 
     #(Menu
        (
         (MenuItem
            label: 'File'
            translateLabel: true
            submenu: 
           (Menu
              (
               (MenuItem
                  label: 'Exit'
                  itemValue: closeRequest
                  translateLabel: true
                )
               )
              nil
              nil
            )
          )
         (MenuItem
            label: 'View'
            translateLabel: true
            submenu: 
           (Menu
              (
               (MenuItem
                  label: 'Dynamically Loaded ClassLibraries Only'
                  translateLabel: true
                  hideMenuOnActivated: false
                  itemValue: showOnlyDynamicallyLoadedClassLibraries
                )
               (MenuItem
                  label: '-'
                )
               (MenuItem
                  label: 'Builtin'
                  translateLabel: true
                  hideMenuOnActivated: false
                  indication: showBuiltIn
                )
               (MenuItem
                  label: 'Class Libraries'
                  translateLabel: true
                  hideMenuOnActivated: false
                  indication: showClassLibs
                )
               (MenuItem
                  label: 'Methods'
                  translateLabel: true
                  hideMenuOnActivated: false
                  indication: showMethods
                )
               (MenuItem
                  label: 'C-Objects'
                  translateLabel: true
                  hideMenuOnActivated: false
                  indication: showCObjects
                )
               (MenuItem
                  label: 'Others'
                  translateLabel: true
                  hideMenuOnActivated: false
                  indication: showOthers
                )
               (MenuItem
                  label: '-'
                )
               (MenuItem
                  label: 'Update'
                  itemValue: menuUpdateModuleList
                  translateLabel: true
                )
               )
              nil
              nil
            )
          )
         (MenuItem
            label: 'Module'
            translateLabel: true
            submenu: 
           (Menu
              (
               (MenuItem
                  enabled: canBrowseSelectedModule
                  label: 'Browse'
                  itemValue: browseModule
                  translateLabel: true
                )
               (MenuItem
                  enabled: canBrowseSelectedModulesExtensions
                  label: 'Browse Extensions'
                  itemValue: browseModuleExtensions
                  translateLabel: true
                )
         (MenuItem
            label: 'Find a Class...'
            itemValue: findClass
            translateLabel: true
          )
               (MenuItem
                  label: '-'
                )
               (MenuItem
                  enabled: canCopyClassNameList
                  label: 'Copy Version Info to Clipboard'
                  itemValue: copyClassOrVMNameList
                  translateLabel: true
                )
               (MenuItem
                  label: '-'
                )
               (MenuItem
                  label: 'Load Package...'
                  itemValue: loadPackage
                  translateLabel: true
                )
               (MenuItem
                  label: '-'
                )
               (MenuItem
                  enabled: canUnloadSelectedModulesPackage
                  label: 'Unload Package...'
                  itemValue: unloadSelectedModulesPackage
                  translateLabel: true
                )
               (MenuItem
                  enabled: canUnloadSelectedDLL
                  label: 'Remove Classes && Unload DLL...'
                  itemValue: unloadSelectedModuleAndRemoveClasses
                  translateLabel: true
                )
               (MenuItem
                  enabled: canUnloadSelectedModule
                  label: 'Unload DLL...'
                  itemValue: unloadSelectedModule
                  translateLabel: true
                )
               )
              nil
              nil
            )
          )
         (MenuItem
            label: 'Help'
            translateLabel: true
            startGroup: conditionalRight
            submenu: 
           (Menu
              (
               (MenuItem
                  label: 'Documentation'
                  itemValue: openDocumentation
                  translateLabel: true
                )
               (MenuItem
                  label: '-'
                )
               (MenuItem
                  label: 'About this Application...'
                  itemValue: openAboutThisApplication
                  translateLabel: true
                )
               )
              nil
              nil
            )
          )
         )
        nil
        nil
      )
!

moduleItemMenu
    "This resource specification was automatically generated
     by the MenuEditor of ST/X."

    "Do not manually edit this!! If it is corrupted,
     the MenuEditor may not be able to read the specification."

    "
     MenuEditor new openOnClass:Tools::ObjectModuleInformation andSelector:#moduleItemMenu
     (Menu new fromLiteralArrayEncoding:(Tools::ObjectModuleInformation moduleItemMenu)) startUp
    "

    <resource: #menu>

    ^ 
     #(Menu
        (
         (MenuItem   
            enabled: canBrowseSelectedClass
            label: 'Browse'
            itemValue: browseClass
            translateLabel: true
          )
         (MenuItem   
            label: '-'
          )
         (MenuItem   
            enabled: canCopyClassNameList
            label: 'Copy Version Info to Clipboard'
            itemValue: copyClassOrVMNameList
            translateLabel: true
          )
         )
        nil
        nil
      )
!

moduleMenu
    "This resource specification was automatically generated
     by the MenuEditor of ST/X."

    "Do not manually edit this!! If it is corrupted,
     the MenuEditor may not be able to read the specification."

    "
     MenuEditor new openOnClass:Tools::ObjectModuleInformation andSelector:#moduleMenu
     (Menu new fromLiteralArrayEncoding:(Tools::ObjectModuleInformation moduleMenu)) startUp
    "

    <resource: #menu>

    ^ 
     #(Menu
        (
         (MenuItem
            enabled: canBrowseSelectedModule
            label: 'Browse'
            itemValue: browseModule
            translateLabel: true
          )
         (MenuItem
            enabled: canBrowseSelectedModulesExtensions
            label: 'Browse Extensions'
            itemValue: browseModuleExtensions
            translateLabel: true
          )
         (MenuItem
            label: 'Find a Class...'
            itemValue: findClass
            translateLabel: true
          )
         (MenuItem
            label: '-'
          )
         (MenuItem
            enabled: canCopyClassNameList
            label: 'Copy Version Info to Clipboard'
            itemValue: copyClassOrVMNameList
            translateLabel: true
          )
         (MenuItem
            label: '-'
          )
         (MenuItem
            enabled: canUnloadSelectedModulesPackage
            label: 'Unload Package...'
            itemValue: unloadSelectedModulesPackage
            translateLabel: true
          )
         (MenuItem
            enabled: canUnloadSelectedModule
            label: 'Remove Classes && Unload DLL...'
            itemValue: unloadSelectedModuleAndRemoveClasses
            translateLabel: true
          )
         (MenuItem
            enabled: canUnloadSelectedDLL
            label: 'Unload DLL...'
            itemValue: unloadSelectedModule
            translateLabel: true
          )
         (MenuItem
            label: '-'
          )
         (MenuItem
            label: 'Update'
            itemValue: menuUpdateModuleList
            translateLabel: true
          )
         )
        nil
        nil
      )
!

toolbarMenu
    "This resource specification was automatically generated
     by the MenuEditor of ST/X."

    "Do not manually edit this!! If it is corrupted,
     the MenuEditor may not be able to read the specification."

    "
     MenuEditor new openOnClass:Tools::ObjectModuleInformation andSelector:#toolbarMenu
     (Menu new fromLiteralArrayEncoding:(Tools::ObjectModuleInformation toolbarMenu)) startUp
    "

    <resource: #menu>

    ^ 
     #(Menu
        (
         (MenuItem
            label: 'Update'
            itemValue: menuUpdateModuleList
            translateLabel: true
            isButton: true
            labelImage: (ResourceRetriever ToolbarIconLibrary reloadIcon)
          )
         (MenuItem
            label: '-'
          )
         (MenuItem
            enabled: canBrowseSelectedModule
            label: 'Browse the Selected Module''s Classes'
            itemValue: browseModule
            translateLabel: true
            isButton: true
            labelImage: (ResourceRetriever ToolbarIconLibrary startSystemBrowserIcon)
          )
         (MenuItem
            enabled: canBrowseSelectedModulesExtensions
            label: 'Browse the Selected Module''s Extensions'
            itemValue: browseModuleExtensions
            translateLabel: true
            isButton: true
            labelImage: (ResourceRetriever ToolbarIconLibrary browseClassExtensionsIcon)
          )
         )
        nil
        nil
      )
! !

!ObjectModuleInformation class methodsFor:'tableColumns specs'!

tableColumns
    "This resource specification was automatically generated
     by the DataSetBuilder of ST/X."

    "Do not manually edit this!! If it is corrupted,
     the DataSetBuilder may not be able to read the specification."

    "
     DataSetBuilder new openOnClass:ObjectModuleInformation andSelector:#tableColumns
    "

    <resource: #tableColumns>

    ^#(
      (DataSetColumnSpec
         label: 'Name'
         activeHelpKey: ''
         labelButtonType: Button
         width: 0.5
         model: name
         canSelect: false
       )
      (DataSetColumnSpec
         label: 'Version'
         activeHelpKey: ''
         labelButtonType: Button
         model: version
         canSelect: false
       )
      (DataSetColumnSpec
         label: 'Date'
         activeHelpKey: ''
         labelButtonType: Button
         model: date
         canSelect: false
       )
      )
    
!

tableColumnsForSingleInfo
    "This resource specification was automatically generated
     by the DataSetBuilder of ST/X."

    "Do not manually edit this!! If it is corrupted,
     the DataSetBuilder may not be able to read the specification."

    "
     DataSetBuilder new openOnClass:Tools::ObjectModuleInformation andSelector:#tableColumnsForSingleInfo
    "

    <resource: #tableColumns>

    ^#(
      (DataSetColumnSpec
         label: ''
         activeHelpKey: ''
         labelButtonType: None
         width: 0.3
         model: name
         canSelect: false
       )
      (DataSetColumnSpec
         label: ''
         activeHelpKey: ''
         labelButtonType: None
         model: value
         canSelect: false
       )
      )
    
! !

!ObjectModuleInformation methodsFor:'aspects'!

canBrowseSelectedClass
    ^ [classNamesShown notEmptyOrNil
       and:[ self selectedInfoIndex notNil
       and:[ self selectedInfoIndex ~~ 0 ]]]

    "Modified: / 05-10-2007 / 10:51:39 / cg"
!

canBrowseSelectedModule
    canBrowseSelectedModule isNil ifTrue:[
        canBrowseSelectedModule := false asValue
    ].
    ^ canBrowseSelectedModule.

    "Modified: / 05-10-2007 / 10:51:39 / cg"
!

canBrowseSelectedModulesExtensions
    canBrowseSelectedModulesExtensions isNil ifTrue:[
        canBrowseSelectedModulesExtensions := false asValue
    ].
    ^ canBrowseSelectedModulesExtensions.

    "Modified: / 05-10-2007 / 10:51:39 / cg"
!

canCopyClassNameList
    ^ [table1VisibleHolder value 
    and:[classInfoShown notEmptyOrNil or:[vmInfoShown notEmptyOrNil] ]]

    "Modified: / 05-10-2007 / 10:51:39 / cg"
!

canUnloadSelectedDLL
    canUnloadSelectedDLL isNil ifTrue:[
        canUnloadSelectedDLL := false asValue
    ].
    ^ canUnloadSelectedDLL.

    "Modified: / 05-10-2007 / 10:51:39 / cg"
!

canUnloadSelectedModule
    canUnloadSelectedModule isNil ifTrue:[
        canUnloadSelectedModule := false asValue
    ].
    ^ canUnloadSelectedModule.

    "Modified: / 05-10-2007 / 10:51:39 / cg"
!

canUnloadSelectedModulesPackage
    canUnloadSelectedModulesPackage isNil ifTrue:[
        canUnloadSelectedModulesPackage := false asValue
    ].
    ^ canUnloadSelectedModulesPackage.
!

infoTable1ListHolder
    ^ builder valueAspectFor:#'infoTable1ListHolder' initialValue:#()

    "Created: / 05-10-2007 / 12:48:06 / cg"
!

infoTable2ListHolder
    ^ builder valueAspectFor:#'infoTable2ListHolder' initialValue:#()

    "Created: / 05-10-2007 / 12:48:10 / cg"
!

listOfModuleNames
    listOfModuleNames isNil ifTrue:[
        listOfModuleNames := List new.
    ].
    ^ listOfModuleNames.

    "Modified: / 05-10-2007 / 10:49:19 / cg"
!

middleLabelHolder
    ^ builder valueAspectFor:#'middleLabelHolder' initialValue:''

    "Created: / 05-10-2007 / 11:05:08 / cg"
!

notReadOnly
    ^ self readOnly not

    "Created: / 05-10-2007 / 13:06:00 / cg"
!

readOnly
    ^ readOnly ? false

    "Created: / 05-10-2007 / 13:05:51 / cg"
!

readOnly:aBoolean
    readOnly := aBoolean

    "Created: / 05-10-2007 / 13:05:51 / cg"
!

selectedInfoIndex
    |sel|

    sel := self selectedInfoIndexHolder value.
    ^ sel
!

selectedInfoIndexHolder
    selectedInfoIndexHolder isNil ifTrue:[
        selectedInfoIndexHolder := ValueHolder new.
        selectedInfoIndexHolder onChangeSend:#selectedInfoIndexChanged to:self.
    ].
    ^ selectedInfoIndexHolder.

    "Modified: / 05-10-2007 / 10:51:39 / cg"
!

selectedModuleIndex
    |sel|

    sel := self selectedModuleIndexHolder value.
    ^ sel
!

selectedModuleIndexHolder
    selectedModuleIndexHolder isNil ifTrue:[
        selectedModuleIndexHolder := ValueHolder new.
        selectedModuleIndexHolder onChangeSend:#selectedModuleIndexChanged to:self.
    ].
    ^ selectedModuleIndexHolder.

    "Modified: / 05-10-2007 / 10:51:39 / cg"
!

showBuiltIn
    showBuiltIn isNil ifTrue:[
        showBuiltIn := true asValue.
        showBuiltIn onChangeSend:#filterChanged to:self.
    ].
    ^ showBuiltIn

    "Modified: / 05-10-2007 / 12:43:23 / cg"
!

showCObjects
    showCObjects isNil ifTrue:[
        showCObjects := true asValue.
        showCObjects onChangeSend:#filterChanged to:self.
    ].
    ^ showCObjects

    "Modified: / 05-10-2007 / 12:43:16 / cg"
!

showClassLibs
    showClassLibs isNil ifTrue:[
        showClassLibs := true asValue.
        showClassLibs onChangeSend:#filterChanged to:self.
    ].
    ^ showClassLibs

    "Modified: / 05-10-2007 / 12:43:10 / cg"
!

showMethods
    showMethods isNil ifTrue:[
        showMethods := true asValue.
        showMethods onChangeSend:#filterChanged to:self.
    ].
    ^ showMethods

    "Modified: / 05-10-2007 / 12:43:02 / cg"
!

showOnlyDynamicallyLoadedClassLibraries
    self showBuiltIn value:false withoutNotifying:self.
    self showCObjects value:false withoutNotifying:self.
    self showMethods value:false withoutNotifying:self.
    self showOthers value:false withoutNotifying:self.
    self showClassLibs value:true withoutNotifying:self.
    self filterChanged.
!

showOthers
    showOthers isNil ifTrue:[
        showOthers := true asValue.
        showOthers onChangeSend:#filterChanged to:self.
    ].
    ^ showOthers

    "Modified: / 05-10-2007 / 12:42:54 / cg"
!

table1VisibleHolder
    table1VisibleHolder isNil ifTrue:[
        table1VisibleHolder := true asValue.
    ].
    ^ table1VisibleHolder.

    "Modified: / 05-10-2007 / 12:53:05 / cg"
!

table2VisibleHolder
    table2VisibleHolder isNil ifTrue:[
        table2VisibleHolder := false asValue.
    ].
    ^ table2VisibleHolder.

    "Modified: / 05-10-2007 / 12:53:14 / cg"
! !

!ObjectModuleInformation methodsFor:'change & update'!

isExtensionName:nm
    ^ (nm endsWith:'_extensions')
!

selectedInfoIndexChanged
!

selectedModule
    |sel|

    sel := self selectedModuleIndex.
    sel isNil ifTrue:[^ nil].
    ^ objectHandles at:sel.
!

selectedModuleIndexChanged
    | info |

    info := self selectedModuleInfo.

    self canBrowseSelectedModule value:false.
    self canBrowseSelectedModulesExtensions value:false.
    self canUnloadSelectedDLL value:false.
    self canUnloadSelectedModule value:false.
    self canUnloadSelectedModulesPackage value:false.

    classNamesShown := nil.
    classInfoShown := nil.
    vmInfoShown := nil.

    info isNil ifTrue:[
        "/ selected a cObject or unknown
        self showInfoForNonClassLib:(self selectedModuleIndex).
        ^ self.
    ].
    info == #VM ifTrue:[
        "/ selected the pseudo entry for the VM itself
        self showInfoForVM.
        ^ self.
    ].

    "/ selected a class-library package
    self showInfoForClassLib:info.

    "Modified: / 05-10-2007 / 12:56:13 / cg"
!

selectedModuleInfo
    |sel|

    sel := self selectedModuleIndex.
    sel notNil ifTrue:[
        (self showClassLibs value or:[self showBuiltIn value]) ifTrue:[
            ^ allModules at:sel ifAbsent:nil.
        ].
    ].
    ^ nil
!

selectedObjectHandle
    |sel|

    sel := self selectedModuleIndex.
    sel isNil ifTrue:[^ nil].
    ^ objectHandles at:sel.
!

showInfoForClassLib:info
    " selected a lib-package; fill bottom list with class-info "

    |rows libraryName defClassName libraryDefinition mgr defClassNames 
     canUnload canUnloadPackage|

    self canBrowseSelectedModule value:true.

    self canBrowseSelectedModulesExtensions 
        value:(info classNames contains:[:nm | self isExtensionName:nm]).

    canUnload := info dynamic and:[self readOnly not].
    self canUnloadSelectedModule value:canUnload.
    canUnloadPackage := canUnload and:[ self selectedModulesProjectDefinitionClass notNil ].
    self canUnloadSelectedModulesPackage value:canUnloadPackage.

    self middleLabelHolder value:'Contains Components:'.

    "/ try to figure out, what the definitionClass is inside that module.
    "/ in the future, we should always find one there, however, old libs or
    "/ special libraries (hand built) might be without a projectDefinition.
    defClassNames := (info classNames ? #()) 
                        select:[:nm |                
                            |cls| 
                            cls := Smalltalk classNamed:nm.
                            cls isBehavior and:[ cls isProjectDefinition ]].

    defClassNames size == 1 ifTrue:[
        libraryName := defClassNames first
    ] ifFalse:[
        "/ fallback - some heuristics...
        libraryName := info libraryName.
        (libraryName notNil and:[ libraryName startsWith:'lib' ]) ifTrue:[
            defClassName := libraryName copyFrom:4
        ] ifFalse:[
            "/ self halt.
        ].
    ].
    defClassName notNil ifTrue:[
        libraryDefinition := Smalltalk classNamed:defClassName.
    ].

    classNamesShown := self shownClassNamesFor:info.

    rows := classNamesShown collect:[:cName |
                    |cls entry rev listEntry revisionInfo versionString dateString|

                    listEntry := InfoRow new.
                    listEntry name:cName.

                    cls := Smalltalk classNamed:cName.
                    cls isNil ifTrue:[
                        (self isExtensionName:cName) ifFalse:[
                            versionString := '(class removed)'.
                        ] ifTrue:[
                            libraryDefinition notNil ifTrue:[
                                mgr := libraryDefinition sourceCodeManager.
                                versionString := libraryDefinition perform:(mgr nameOfVersionMethodForExtensions) ifNotUnderstood:nil.
                                versionString notNil ifTrue:[
                                    versionString := '(bin: ',(mgr revisionInfoFromString:versionString) revision,')'.
                                ]
                            ].
                        ].
                    ] ifFalse:[
                        rev := cls binaryRevision.
                        rev notNil ifTrue:[
                            cls isLoaded ifFalse:[
                                entry := '(stub for: ' , rev.
                            ] ifTrue:[
                                entry :='(bin: ' , rev.
                            ].    
                            cls revision ~= rev ifTrue:[
                                entry := entry , ' / src: ' , (cls revision printString)
                            ].
                            entry := entry , ')'.
                            versionString := entry
                        ] ifFalse:[
                            cls revision notNil ifTrue:[
                                versionString := '(overloaded by: ' , cls revision , ')' 
                            ]
                        ].
                        revisionInfo := cls revisionInfo.
                        revisionInfo notNil ifTrue:[
                            dateString := (revisionInfo at:#date)
                        ].
                    ].
                    listEntry version:versionString.
                    listEntry date:dateString
                  ].

    classInfoShown := rows.

    self infoTable1ListHolder value:rows.
    self table1VisibleHolder value:true.
    self table2VisibleHolder value:false.

    "Modified: / 05-10-2007 / 13:03:56 / cg"
!

showInfoForNonClassLib:sel
    " selected a method, cObject or unknown "

    |module fileName list entry|

    sel isNil ifTrue:[
        self table1VisibleHolder value:false.
        self table2VisibleHolder value:false.
        ^ self.
    ].

    module := objectHandles at:sel.
    fileName := module pathName.

    module isMethodHandle ifTrue:[
        |method nm entry1 entry2 entry3|

        self canUnloadSelectedDLL value:true.

        self middleLabelHolder value:'Compiled Method:'.

        (method := module method) isNil ifTrue:[
            nm := '** removed **'.
        ] ifFalse:[
            self canBrowseSelectedModule value:true.
"/            menu := PopUpMenu
"/                        labels:#('Inspect' 'Browse')
"/                        selectors:#(inspect browse).
"/            menu actionAt:#inspect put:[ method inspect ].
"/            menu actionAt:#browse put:[ |who|
"/                                        who := method who.
"/                                        UserPreferences systemBrowserClass
"/                                            openInClass:(who methodClass) 
"/                                            selector:(who methodSelector) 
"/                                      ].
"/            listView1 middleButtonMenu:menu.

            nm := (method whoString) asText emphasizeAllWith:(#color->Color blue).
        ].
        entry1 := InfoRow new.
        entry1 name:'Compiled method'; value:nm.

        entry2 := InfoRow new.
        entry2 name:'Path'; value:fileName.

        entry3 := InfoRow new.
        entry3 name:'Address'; value:('(16r) ' , (method code address hexPrintString leftPaddedTo:8 with:$0)).

        self infoTable2ListHolder value:(Array with:entry1 with:entry2 with:entry3).
        self table1VisibleHolder value:false.
        self table2VisibleHolder value:true.
        ^ self.
    ].

    (module isFunctionObjectHandle 
    and:[module functions notEmpty]) ifTrue:[
        self middleLabelHolder value:'Functions:'.

"/        menu := PopUpMenu
"/                    labels:#('Inspect')
"/                    selectors:#(inspect).
"/        menu actionAt:#inspect put:[ module functions inspect  ].
"/        listView1 middleButtonMenu:menu.
"/
        list := (module functions select:[:f | f notNil])
                        collect:[:f | |entry|
                                        entry := InfoRow new.
                                        entry name:(f name asText emphasizeAllWith:(#color->Color blue)).
                                        entry value:('address: (16r) ' , (f code address hexPrintString leftPaddedTo:8 with:$0)).
                                        entry
                                ].
        self infoTable2ListHolder value:list.
        self table1VisibleHolder value:false.
        self table2VisibleHolder value:true.
        ^ self.
    ].

    entry := InfoRow new.
    entry name:'Unknown'.
    self infoTable2ListHolder value:(Array with:entry).
    self table1VisibleHolder value:false.
    self table2VisibleHolder value:true.

    "Modified: / 05-10-2007 / 13:01:33 / cg"
!

showInfoForVM
    " show file versions of vm info in lower view. "

    |l|

    self canBrowseSelectedModule value:false.

    self middleLabelHolder value:'Contains Components:'.

    l := (ObjectMemory getVMIdentificationStrings).
    l := l select:[:entry | entry includesString:'$Header'].
    l := l select:[:entry | entry includesString:',v'].
    l := l collect:[:entry |
        |i1 i2 file revision date listEntry|

        listEntry := InfoRow new.

        i1 := entry indexOfSubCollection:'librun'.
        i1 ~~ 0 ifTrue:[
            i2 := entry indexOfSubCollection:',v' startingAt:i1.
            i2 ~~ 0 ifTrue:[
                file := entry copyFrom:i1+7 to:(i2-1).
                listEntry name:file.

                i1 := i2+3.
                i2 := entry indexOfSeparatorStartingAt:i1.
                revision := entry copyFrom:i1 to:(i2-1).
                listEntry version:revision.

                i1 := i2+1.
                i2 := entry indexOfSeparatorStartingAt:i1.
                date := entry copyFrom:i1 to:(i2-1).
                listEntry date:date.
            ].
        ].
        listEntry.
    ].

    vmInfoShown := l.
    self infoTable1ListHolder value:l.
    self table1VisibleHolder value:true.
    self table2VisibleHolder value:false.

"/    readOnly ifFalse:[
"/        unloadButton disable.
"/        unloadAndRemoveButton disable.
"/    ]

    "Modified: / 05-10-2007 / 12:53:44 / cg"
!

shownClassNamesFor:info
    "/ selected a package; fill bottom list with class-info

    |classNames|

    classNames := info classNames asSortedCollection.
    ^ classNames 
        select:[:cName |
            |cls|

            cls := Smalltalk classNamed:cName.
            cls isNil ifTrue:[
                true "a removed class"
            ] ifFalse:[
                cls isPrivate not
            ].
        ].
! !

!ObjectModuleInformation methodsFor:'initialization'!

postBuildWith:aBuilder
    |canDoIt|

    super postBuildWith:aBuilder.

    canDoIt := ObjectFileLoader notNil and:[ObjectFileLoader canLoadObjectFiles].
    self showBuiltIn value:canDoIt.
    self showCObjects value:canDoIt.
    self showClassLibs value:canDoIt.
    self showMethods value:canDoIt.
    self showOthers value:canDoIt.

    self updateModuleList

    "Created: / 05-10-2007 / 10:50:27 / cg"
! !

!ObjectModuleInformation methodsFor:'menu actions'!

browseClass
    |info classNames selectedClassName selectedClass|

    info := self selectedModuleInfo.
    classNames := (self shownClassNamesFor:info) asSortedCollection.
    selectedClassName := classNames at:(self selectedInfoIndex).
    selectedClass := Smalltalk classNamed:selectedClassName.

    selectedClass notNil ifTrue:[
        Smalltalk browseInClass:selectedClass.
        ^ self.
    ].

    "/ clicked on an extensions-module ?
    (self isExtensionName:selectedClassName) ifTrue:[
        self browseModuleExtensions.
        ^ self.
    ].

    self breakPoint:#cg.
!

browseModule
    |moduleInfoOrHandle classes method|

    moduleInfoOrHandle := self selectedObjectHandle.
    "/ what a hack
    (moduleInfoOrHandle isKindOf: ObjectMemory::BinaryModuleDescriptor) ifTrue:[
        classes := moduleInfoOrHandle classNames collect:[:nm | Smalltalk classNamed:nm].
        UserPreferences systemBrowserClass 
            browseClasses:classes
            label:(resources string:'Classes in %1' with:moduleInfoOrHandle libraryName)
    ] ifFalse:[
        moduleInfoOrHandle isMethodHandle ifTrue:[
            method := moduleInfoOrHandle method.
            (method notNil and:[method mclass notNil]) ifFalse:[
                Dialog information:'The method has been redefined/removed'.
                ^ self.
            ].
            UserPreferences systemBrowserClass 
                openInMethod:method
        ]
    ].
!

browseModuleExtensions
    |info name packageID methods|

    info := self selectedModuleInfo.

    name := info classNames detect:[:nm | self isExtensionName:nm].
    packageID := (name copyWithoutLast:('_extensions' size)) asSymbol.
    methods := Smalltalk allExtensionsForPackage:packageID.
    (UserPreferences browserClass) browseMethods:methods title:('Extensions for ',packageID).
!

copyClassOrVMNameList
    |text|

    text := ((classInfoShown ? vmInfoShown)collect:[:eachRow | eachRow infoString]) asStringCollection asString.
    self window setClipboardText:text.
!

findClass
    |class moduleIndex classNamesShown classIndex|

    class := Dialog requestClass:'Classname (Tab for completion):'.
    class isEmptyOrNil ifTrue:[^ self].

    moduleIndex := allModules findFirst:[:module | module isSymbol not and:[module classNames includes:class name]].
    moduleIndex == 0 ifTrue:[
        Dialog information:'Class is not contained in a loaded or builtIn package.'.
        ^ self
    ].
    self selectedModuleIndexHolder value:moduleIndex.

    classNamesShown := self shownClassNamesFor:(self selectedModuleInfo).
    classIndex := classNamesShown indexOf:class name.
    self selectedInfoIndexHolder value:classIndex.

"/    module := allModules at:moduleIndex.
"/    info := self selectedModuleInfo.
"/    classNames := (self shownClassNamesFor:info) asSortedCollection.
"/    selectedClassName := classNames at:(self selectedInfoIndex).
"/    selectedClass := Smalltalk classNamed:selectedClassName.
"/
"/    selectedClass notNil ifTrue:[
"/        Smalltalk browseInClass:selectedClass.
"/        ^ self.
"/    ].
"/
"/    "/ clicked on an extensions-module ?
"/    (self isExtensionName:selectedClassName) ifTrue:[
"/        self browseModuleExtensions.
"/        ^ self.
"/    ].
"/
"/    self breakPoint:#cg.
!

loadPackage
    |package ok|

    package := Dialog request:'Name of Package (module:directory)'.
    package isEmptyOrNil ifTrue:[^ self].
    self withWaitCursorDo:[
        ok := Smalltalk loadPackage:package.
    ].
    ok ifFalse:[
        Dialog information:'Package not loaded'
    ].
    self updateModuleList
!

menuUpdateModuleList
    self updateModuleList

    "Modified: / 05-10-2007 / 13:11:45 / cg"
!

openDocumentation
    self openHTMLDocument: 'tools/misc/TOP.html#MODULEINFO'

    "Modified: / 05-10-2007 / 13:11:45 / cg"
!

selectedModulesProjectDefinitionClass
    | info classNames classes definitionClasses|

    info := self selectedModuleInfo.
    classNames := (self shownClassNamesFor:info) asSortedCollection.
    classes := classNames collect:[:nm | Smalltalk classNamed:nm].
    definitionClasses := classes select:[:cls | cls isProjectDefinition].
    definitionClasses size == 1 ifTrue:[
        ^ definitionClasses first
    ].
    ^ nil
!

unloadSelectedModule
    self unloadSelectedModuleRemoveClasses:false
!

unloadSelectedModuleAndRemoveClasses
    self unloadSelectedModuleRemoveClasses:true
!

unloadSelectedModuleRemoveClasses:doRemoveClasses
    (Dialog 
        confirm:'This is a possibly dangerous operation, as the DLL is unloaded without caring for 
proper package-deinstallation procedures. Please use this only in repair situations and when the 
regular unloadPackage operation fails.

Continue ?')
    ifFalse:[
        ^ self  
    ].

    self withWaitCursorDo:[
        |info idx handle pathName|

        info := self selectedModuleInfo.
        handle := objectHandles at:(self selectedModuleIndex).
        self selectedModuleIndexHolder value:nil.

        info isNil ifTrue:[
            "/ selected a method
            "/ idx := idx - allModules size.
            pathName := handle pathName.
        ] ifFalse:[
            "/ selected a package
            pathName := info pathName.
        ].
        pathName notNil ifTrue:[
            doRemoveClasses ifTrue:[
                ObjectFileLoader unloadObjectFileAndRemoveClasses:pathName.
            ] ifFalse:[
                ObjectFileLoader unloadObjectFile:pathName.
            ]
        ].
        self updateModuleList.
    ]
!

unloadSelectedModulesPackage
    |definitionClass|

    definitionClass := self selectedModulesProjectDefinitionClass.
    definitionClass isNil ifTrue:[^ self].

    (Dialog 
        confirm:(resources stringWithCRs:'About to unload the package\\    %1\\Continue' with:definitionClass package allBold))
    ifFalse:[
        ^ self
    ].
    Smalltalk unloadPackage:definitionClass package.
! !

!ObjectModuleInformation methodsFor:'private'!

filterChanged
    self updateModuleList

    "Created: / 05-10-2007 / 12:43:36 / cg"
!

updateModuleList
    |showClassLibs showBuiltIn showMethods showCObjects showOthers
     listOfModuleNames allObjects handles methodObjects |

    showClassLibs := self showClassLibs value.
    showBuiltIn := self showBuiltIn value.
    showMethods := self showMethods value.
    showCObjects := self showCObjects value.
    showOthers := self showOthers value.

    listOfModuleNames := OrderedCollection new.
    handles := OrderedCollection new.

    allObjects := ObjectFileLoader loadedObjectHandles.
    methodObjects := (allObjects select:[:h | h isMethodHandle]) asArray.

    (showClassLibs or:[showBuiltIn]) ifTrue:[
        |moduleNames|

        allModules := ObjectMemory binaryModuleInfo asOrderedCollection.
        allModules := allModules select:
                                    [:i |
                                        |wantToSee|

                                        wantToSee := false.
                                        i dynamic ifTrue:[
                                            showClassLibs ifTrue:[
                                                i isSingleMethod ifFalse:[
                                                    wantToSee := true
                                                ].
                                            ].
                                        ] ifFalse:[
                                            showBuiltIn ifTrue:[
                                                wantToSee := true
                                            ].
                                        ].
                                        wantToSee
                                    ].

        "/ sorting by reverse id brings newest ones to the top (a side effect)
        allModules sort:[:a :b | (a name) < (b name)].
        moduleNames := allModules collect:[:entry | entry name].
        listOfModuleNames addAll:moduleNames.
        handles addAll:allModules.
    ].

    showMethods ifTrue:[
        |methodNames|

        methodNames := methodObjects collect:[:mH | mH method isNil ifTrue:[
                                                        'compiled method - removed' " , ' (in ' , mH pathName , ')' "
                                                    ] ifFalse:[
                                                        'compiled method ' , mH method whoString  " , ' (in ' , mH pathName , ')' "
                                                    ].
                                             ].
        listOfModuleNames addAll:methodNames.
        handles addAll:methodObjects.
    ].

    showCObjects ifTrue:[
        |cObjects cObjectNames|

        cObjects := (allObjects select:[:h | h isFunctionObjectHandle]) asArray.
        cObjectNames := cObjects collect:[:entry | entry pathName].
        listOfModuleNames addAll:cObjectNames.
        handles addAll:cObjects.
    ].

    showOthers ifTrue:[
        |otherObjects otherObjectNames|

        otherObjects := (allObjects select:[:h | (h isFunctionObjectHandle
                                                 or:[h isMethodHandle
                                                 or:[h isClassLibHandle]]) not]) asArray.
        otherObjectNames := otherObjects collect:[:entry | entry pathName].
        listOfModuleNames addAll:otherObjectNames.
        handles addAll:otherObjects.
    ].

    showBuiltIn ifTrue:[
        listOfModuleNames addFirst:'VM'.
        handles addFirst:#VM.
        allModules addFirst:#VM.
    ].

    self listOfModuleNames contents:listOfModuleNames.
    objectHandles := handles.
    self selectedModuleIndexChanged.

    "Modified: / 05-10-2007 / 12:45:37 / cg"
! !

!ObjectModuleInformation::InfoRow methodsFor:'accessing'!

date
    ^ date
!

date:something
    date := something.
!

name
    ^ name
!

name:something
    name := something.
!

name:nameArg version:versionArg date:dateArg 
    name := nameArg.
    version := versionArg.
    date := dateArg.
!

value
    ^ value
!

value:something
    value := something.
!

version
    ^ version
!

version:something
    version := something.
! !

!ObjectModuleInformation::InfoRow methodsFor:'info'!

infoString
    ^ name , ' ', (version ? '-') , ' ', (date ? '-') printString
! !

!ObjectModuleInformation class methodsFor:'documentation'!

version
    ^ '$Header$'
!

version_CVS
    ^ '$Header$'
! !