Tools__ObjectModuleInformation.st
author Claus Gittinger <cg@exept.de>
Mon, 18 May 2009 12:11:38 +0200
changeset 2533 460098ee1f39
parent 2403 11c5c82a852c
child 2616 01e597429c47
permissions -rw-r--r--
*** empty log message ***

"{ 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'
	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 30 0)
              menu: toolbarMenu
              textDefault: true
            )
           (VariableVerticalPanelSpec
              name: 'VariableVerticalPanel1'
              layout: (LayoutFrame 0 0 30 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: '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: canCopyClassNameList
                  label: 'Copy Version Info to Clipboard'
                  itemValue: copyClassOrVMNameList
                  translateLabel: true
                )
               (MenuItem
                  label: '-'
                )
               (MenuItem
                  enabled: canUnloadSelectedModule
                  label: 'Unload'
                  itemValue: unloadSelectedModule
                  translateLabel: true
                )
               (MenuItem
                  enabled: canUnloadSelectedModule
                  label: 'Remove Classes && Unload'
                  itemValue: unloadSelectedModuleAndRemoveClasses
                  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: canCopyClassNameList
            label: 'Copy Version Info to Clipboard'
            itemValue: copyClassOrVMNameList
            translateLabel: true
          )
         (MenuItem
            label: '-'
          )
         (MenuItem
            enabled: canUnloadSelectedModule
            label: 'Remove Classes && Unload'
            itemValue: unloadSelectedModuleAndRemoveClasses
            translateLabel: true
          )
         (MenuItem
            enabled: canUnloadSelectedModule
            label: 'Unload'
            itemValue: unloadSelectedModule
            translateLabel: true
          )
         )
        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"
!

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

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

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

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

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"
!

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'!

selectedInfoIndexChanged
!

selectedModule
    |sel|

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

selectedModuleIndexChanged
    |module info|

    info := self selectedModuleInfo.
    module := self selectedModule.

    self canBrowseSelectedModule value:(info notNil and:[info ~~ #VM and:[module notNil]]).
    self canUnloadSelectedModule value:(self readOnly not and:[info ~~ #VM and:[info notNil and:[info dynamic]]]).

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

    info isNil ifTrue:[
        "/ selected a method, 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 info|

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

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

    |rows|

    self middleLabelHolder value:'Contains Modules:'.

    classNamesShown := self shownClassNamesFor:info.

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

                    listEntry := InfoRow new.
                    listEntry name:cName.

                    cls := Smalltalk classNamed:cName.
                    cls isNil ifTrue:[
                        (cName endsWith:'_extensions') ifFalse:[
                            listEntry version:'(class removed)'.
                        ]
                    ] 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 , ')'.
                            listEntry version:entry
                        ] ifFalse:[
                           cls revision notNil ifTrue:[
                                listEntry version:'(overloaded by: ' , cls revision , ')' 
                           ]
                        ].
                        revisionInfo := cls revisionInfo.
                        revisionInfo notNil ifTrue:[
                            listEntry date:(revisionInfo at:#date)
                        ].
                    ].
                    listEntry
                  ].

    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 middleLabelHolder value:'Compiled Method:'.

        (method := module method) isNil ifTrue:[
            nm := '** removed **'.
        ] ifFalse:[
"/            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 in lower view.

    |l|

    self middleLabelHolder value:'Contains Modules:'.

    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
    |module info classNames selectedClassName selectedClass packageID methods|

    module := self selectedModule.
    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 ?
    (selectedClassName endsWith:'_extensions') ifTrue:[
        packageID := (selectedClassName copyWithoutLast:('_extensions' size)) asSymbol.
        methods := Smalltalk allExtensionsForPackage:packageID.
        (UserPreferences browserClass) browseMethods:methods title:('Extensions for ',packageID).
    ].
self halt.
!

browseModule
    |module classes|

    module := self selectedModule.
    classes := module classNames collect:[:nm | Smalltalk classNamed:nm].
    UserPreferences systemBrowserClass 
        browseClasses:classes
        label:(resources string:'Classes in %1' with:module libraryName)
!

copyClassOrVMNameList
    |text|

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

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"
!

unloadSelectedModule
    self unloadSelectedModuleRemoveClasses:false
!

unloadSelectedModuleAndRemoveClasses
    self unloadSelectedModuleRemoveClasses:true
!

unloadSelectedModuleRemoveClasses:doRemoveClasses
    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.
    ]
! !

!ObjectModuleInformation methodsFor:'private'!

filterChanged
    self updateModuleList

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

updateModuleList
    |showClassLibs showBuiltIn showMethods showCObjects showOthers
     listOfModuleNames allObjects handles|

    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.

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

        allModules := ObjectMemory binaryModuleInfo asOrderedCollection.
        (showBuiltIn and:[showClassLibs]) ifFalse:[
            allModules := allModules select:
                                        [:i |
                                            |wantToSee|

                                            wantToSee := i dynamic.
                                            showBuiltIn ifTrue:[
                                                wantToSee := wantToSee not
                                            ].
                                            wantToSee
                                        ]
        ].

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

    showMethods ifTrue:[
        |methodObjects methodNames|

        methodObjects := (allObjects select:[:h | h isMethodHandle]) asArray.
        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.

    "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$'
! !