"{ Package: 'stx:libtool2' }"

"{ NameSpace: Tools }"

ApplicationModel subclass:#ObjectModuleInformation

	instanceVariableNames:'listOfModuleNames selectedModuleIndexHolder allModules'

	classVariableNames:''

	poolDictionaries:''

	category:'Monitors-ST/X'

!

Object subclass:#InfoRow

	instanceVariableNames:'name version date'

	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:]

        cg

"

!

examples

"

  Starting the application:

                                                                [exBegin]

    ObjectModuleInformation open

                                                                [exEnd]

"

! !

!ObjectModuleInformation class methodsFor:'info'!

defaultLabel

    ^ 'Process Monitor'

    "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:ObjectModuleInformation andSelector:#windowSpec

     ObjectModuleInformation new openInterface:#windowSpec

     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

                    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)

                          model: selectedInfoIndexHolder

                          hasHorizontalScrollBar: true

                          hasVerticalScrollBar: true

                          dataList: infoTableListHolder

                          columnHolder: tableColumns

                          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:ObjectModuleInformation andSelector:#mainMenu

     (Menu new fromLiteralArrayEncoding:(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

                  indication: showBuiltIn

                )

               (MenuItem

                  label: 'Class Libraries'

                  translateLabel: true

                  indication: showClassLibs

                )

               (MenuItem

                  label: 'Methods'

                  translateLabel: true

                  indication: showMethods

                )

               (MenuItem

                  label: 'C-Objects'

                  translateLabel: true

                  indication: showCObjects

                )

               (MenuItem

                  label: 'Others'

                  translateLabel: true

                  indication: showOthers

                )

               )

              nil

              nil

            )

          )

         (MenuItem

            label: 'Module'

            translateLabel: true

            submenu: 

           (Menu

              (

               (MenuItem

                  label: 'Unload'

                  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

      )

! !

!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

       )

      )

! !

!ObjectModuleInformation methodsFor:'aspects'!

infoTableListHolder

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

    "Created: / 05-10-2007 / 11:07:50 / 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"

!

selectedModuleIndexHolder

    selectedModuleIndexHolder isNil ifTrue:[

        selectedModuleIndexHolder := ValueHolder new.

        selectedModuleIndexHolder onChangeSend:#selectedModuleIndexChanged to:self.

    ].

    ^ selectedModuleIndexHolder.

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

!

showBuiltIn

    ^ builder valueAspectFor:#'showBuiltIn' initialValue:true

    "Modified: / 05-10-2007 / 10:35:20 / cg"

!

showCObjects

    ^ builder valueAspectFor:#'showCObjects' initialValue:true

    "Modified: / 05-10-2007 / 10:35:23 / cg"

!

showClassLibs

    ^ builder valueAspectFor:#'showClassLibs' initialValue:true

    "Modified: / 05-10-2007 / 10:35:27 / cg"

!

showMethods

    ^ builder valueAspectFor:#'showMethods' initialValue:true

    "Modified: / 05-10-2007 / 10:35:30 / cg"

!

showOthers

    ^ builder valueAspectFor:#'showOthers' initialValue:true

    "Modified: / 05-10-2007 / 10:35:32 / cg"

! !

!ObjectModuleInformation methodsFor:'change & update'!

selectedModuleIndexChanged

    |sel info|

    sel := self selectedModuleIndexHolder value.

    (self showClassLibs value or:[self showBuiltIn value]) ifTrue:[

        info := allModules at:sel ifAbsent:nil.

    ].

    info isNil ifTrue:[

        "/ selected a method, cObject or unknown

        self showInfoForNonClassLib:sel.

        ^ 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 / 11:02:05 / cg"

!

showInfoForClassLib:info

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

    |classNames|

    self middleLabelHolder value:'Contains Modules:'.

    classNames := info classNames asSortedCollection.

    classNames := classNames select:[:cName |

                    |cls|

                    cls := Smalltalk classNamed:cName.

                    cls isNil ifTrue:[

                        true "a removed class"

                    ] ifFalse:[

                        cls isPrivate not

                    ].

                  ].

    classNames := classNames collect:[:cName |

                    |cls entry rev listEntry revisionInfo|

                    listEntry := InfoRow new.

                    listEntry name:cName.

                    cls := Smalltalk classNamed:cName.

                    cls isNil ifTrue:[

                        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

                  ].

    self infoTableListHolder value:classNames.

    "Modified: / 05-10-2007 / 11:26:13 / cg"

!

showInfoForNonClassLib:sel

    "/ selected a method, cObject or unknown

    |objectHandles module fileName list entry|

    module := objectHandles at:sel.

    fileName := module pathName.

    module isMethodHandle ifTrue:[

        |method nm entry1 entry2 entry3|

        self middleLabelHolder value:'Contains 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'; version:nm.

        entry2 := InfoRow new.

        entry2 name:'path'; version:fileName.

        entry3 := InfoRow new.

        entry3 name:'address'; version:('(16r) ' , (method code address hexPrintString leftPaddedTo:8 with:$0)).

        self infoTableListHolder value:(Array with:entry1 with:entry2 with:entry3).

        ^ self.

    ].

    (module isFunctionObjectHandle 

    and:[module functions notEmpty]) ifTrue:[

        self middleLabelHolder value:'Contains 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 version:('address: (16r) ' , (f code address hexPrintString leftPaddedTo:8 with:$0)).

                                        entry

                                ].

        self infoTableListHolder value:list.

        ^ self.

    ].

    entry := InfoRow new.

    entry name:'Unknown'.

    self infoTableListHolder value:(Array with:entry).

    "Modified: / 05-10-2007 / 11:51:38 / 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.