stx-libtool2: Tools__ObjectModuleInformation.st@4e663bc64364

     1 "{ Package: 'stx:libtool2' }"

     3 "{ NameSpace: Tools }"

     5 ToolApplicationModel subclass:#ObjectModuleInformation

     6 	instanceVariableNames:'readOnly listOfModuleNames selectedModuleIndexHolder allModules

     7 		objectHandles showOthers showCObjects showBuiltIn showMethods

     8 		showClassLibs table1VisibleHolder table2VisibleHolder

     9 		selectedInfoIndexHolder canBrowseSelectedModule

    10 		canUnloadSelectedModule classNamesShown classInfoShown

    11 		vmInfoShown'

    12 	classVariableNames:''

    13 	poolDictionaries:''

    14 	category:'Monitors-ST/X'

    15 !

    17 Object subclass:#InfoRow

    18 	instanceVariableNames:'name version date value'

    19 	classVariableNames:''

    20 	poolDictionaries:''

    21 	privateIn:ObjectModuleInformation

    22 !

    24 !ObjectModuleInformation class methodsFor:'documentation'!

    26 documentation

    27 "

    28     Shows the modules (dll's) of ST/X.

    29     Both builtIn modules, and dynamically loaded modules are listed.

    31     [author:]

    32         Claus Gittinger

    33 "

    34 !

    36 examples

    37 "

    38   Starting the application:

    39                                                                 [exBegin]

    40     ObjectModuleInformation open

    42                                                                 [exEnd]

    43 "

    44 ! !

    46 !ObjectModuleInformation class methodsFor:'info'!

    48 defaultLabel

    49     ^ 'Object Module Info'

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

    52 ! !

    54 !ObjectModuleInformation class methodsFor:'interface specs'!

    56 windowSpec

    57     "This resource specification was automatically generated

    58      by the UIPainter of ST/X."

    60     "Do not manually edit this!! If it is corrupted,

    61      the UIPainter may not be able to read the specification."

    63     "

    64      UIPainter new openOnClass:Tools::ObjectModuleInformation andSelector:#windowSpec

    65      Tools::ObjectModuleInformation new openInterface:#windowSpec

    66      Tools::ObjectModuleInformation open

    67     "

    69     <resource: #canvas>

    71     ^

    72      #(FullSpec

    73         name: windowSpec

    74         window:

    75        (WindowSpec

    76           label: 'ST/X Module & Version Information'

    77           name: 'ST/X Module & Version Information'

    78           min: (Point 0 0)

    79           bounds: (Rectangle 0 0 505 567)

    80           menu: mainMenu

    81         )

    82         component:

    83        (SpecCollection

    84           collection: (

    85            (MenuPanelSpec

    86               name: 'ToolBar1'

    87               layout: (LayoutFrame 0 0 0 0 0 1 30 0)

    88               menu: toolbarMenu

    89               textDefault: true

    90             )

    91            (VariableVerticalPanelSpec

    92               name: 'VariableVerticalPanel1'

    93               layout: (LayoutFrame 0 0 30 0 0 1 0 1)

    94               component:

    95              (SpecCollection

    96                 collection: (

    97                  (SequenceViewSpec

    98                     name: 'List1'

    99                     model: selectedModuleIndexHolder

   100                     menu: moduleMenu

   101                     hasHorizontalScrollBar: true

   102                     hasVerticalScrollBar: true

   103                     useIndex: true

   104                     sequenceList: listOfModuleNames

   105                   )

   106                  (ViewSpec

   107                     name: 'Box1'

   108                     component:

   109                    (SpecCollection

   110                       collection: (

   111                        (LabelSpec

   112                           name: 'Label1'

   113                           layout: (LayoutFrame 0 0 0 0 0 1 30 0)

   114                           translateLabel: true

   115                           labelChannel: middleLabelHolder

   116                           adjust: left

   117                         )

   118                        (DataSetSpec

   119                           name: 'Table1'

   120                           layout: (LayoutFrame 0 0 30 0 0 1 0 1)

   121                           visibilityChannel: table1VisibleHolder

   122                           model: selectedInfoIndexHolder

   123                           menu: moduleItemMenu

   124                           hasHorizontalScrollBar: true

   125                           hasVerticalScrollBar: true

   126                           dataList: infoTable1ListHolder

   127                           columnHolder: tableColumns

   128                           separatorOneDColor: (Color 66.999313344015 66.999313344015 66.999313344015)

   129                         )

   130                        (DataSetSpec

   131                           name: 'Table2'

   132                           layout: (LayoutFrame 0 0 30 0 0 1 0 1)

   133                           initiallyInvisible: true

   134                           visibilityChannel: table2VisibleHolder

   135                           model: selectedInfoIndexHolder

   136                           hasHorizontalScrollBar: true

   137                           hasVerticalScrollBar: true

   138                           dataList: infoTable2ListHolder

   139                           columnHolder: tableColumnsForSingleInfo

   140                           separatorOneDColor: (Color 66.999313344015 66.999313344015 66.999313344015)

   141                         )

   142                        )

   144                     )

   145                   )

   146                  )

   148               )

   149               handles: (Any 0.35195530726257 1.0)

   150             )

   151            )

   153         )

   154       )

   155 ! !

   157 !ObjectModuleInformation class methodsFor:'menu specs'!

   159 mainMenu

   160     "This resource specification was automatically generated

   161      by the MenuEditor of ST/X."

   163     "Do not manually edit this!! If it is corrupted,

   164      the MenuEditor may not be able to read the specification."

   166     "

   167      MenuEditor new openOnClass:Tools::ObjectModuleInformation andSelector:#mainMenu

   168      (Menu new fromLiteralArrayEncoding:(Tools::ObjectModuleInformation mainMenu)) startUp

   169     "

   171     <resource: #menu>

   173     ^

   174      #(Menu

   175         (

   176          (MenuItem

   177             label: 'File'

   178             translateLabel: true

   179             submenu:

   180            (Menu

   181               (

   182                (MenuItem

   183                   label: 'Exit'

   184                   itemValue: closeRequest

   185                   translateLabel: true

   186                 )

   187                )

   188               nil

   189               nil

   190             )

   191           )

   192          (MenuItem

   193             label: 'View'

   194             translateLabel: true

   195             submenu:

   196            (Menu

   197               (

   198                (MenuItem

   199                   label: 'Builtin'

   200                   translateLabel: true

   201                   hideMenuOnActivated: false

   202                   indication: showBuiltIn

   203                 )

   204                (MenuItem

   205                   label: 'Class Libraries'

   206                   translateLabel: true

   207                   hideMenuOnActivated: false

   208                   indication: showClassLibs

   209                 )

   210                (MenuItem

   211                   label: 'Methods'

   212                   translateLabel: true

   213                   hideMenuOnActivated: false

   214                   indication: showMethods

   215                 )

   216                (MenuItem

   217                   label: 'C-Objects'

   218                   translateLabel: true

   219                   hideMenuOnActivated: false

   220                   indication: showCObjects

   221                 )

   222                (MenuItem

   223                   label: 'Others'

   224                   translateLabel: true

   225                   hideMenuOnActivated: false

   226                   indication: showOthers

   227                 )

   228                (MenuItem

   229                   label: '-'

   230                 )

   231                (MenuItem

   232                   label: 'Update'

   233                   itemValue: menuUpdateModuleList

   234                   translateLabel: true

   235                 )

   236                )

   237               nil

   238               nil

   239             )

   240           )

   241          (MenuItem

   242             label: 'Module'

   243             translateLabel: true

   244             submenu:

   245            (Menu

   246               (

   247                (MenuItem

   248                   enabled: canBrowseSelectedModule

   249                   label: 'Browse'

   250                   itemValue: browseModule

   251                   translateLabel: true

   252                 )

   253                (MenuItem

   254                   enabled: canCopyClassNameList

   255                   label: 'Copy Version Info to Clipboard'

   256                   itemValue: copyClassOrVMNameList

   257                   translateLabel: true

   258                 )

   259                (MenuItem

   260                   label: '-'

   261                 )

   262                (MenuItem

   263                   enabled: canUnloadSelectedModule

   264                   label: 'Unload'

   265                   itemValue: unloadSelectedModule

   266                   translateLabel: true

   267                 )

   268                (MenuItem

   269                   enabled: canUnloadSelectedModule

   270                   label: 'Remove Classes && Unload'

   271                   itemValue: unloadSelectedModuleAndRemoveClasses

   272                   translateLabel: true

   273                 )

   274                )

   275               nil

   276               nil

   277             )

   278           )

   279          (MenuItem

   280             label: 'Help'

   281             translateLabel: true

   282             startGroup: conditionalRight

   283             submenu:

   284            (Menu

   285               (

   286                (MenuItem

   287                   label: 'Documentation'

   288                   itemValue: openDocumentation

   289                   translateLabel: true

   290                 )

   291                (MenuItem

   292                   label: '-'

   293                 )

   294                (MenuItem

   295                   label: 'About this Application...'

   296                   itemValue: openAboutThisApplication

   297                   translateLabel: true

   298                 )

   299                )

   300               nil

   301               nil

   302             )

   303           )

   304          )

   305         nil

   306         nil

   307       )

   308 !

   310 moduleItemMenu

   311     "This resource specification was automatically generated

   312      by the MenuEditor of ST/X."

   314     "Do not manually edit this!! If it is corrupted,

   315      the MenuEditor may not be able to read the specification."

   317     "

   318      MenuEditor new openOnClass:Tools::ObjectModuleInformation andSelector:#moduleItemMenu

   319      (Menu new fromLiteralArrayEncoding:(Tools::ObjectModuleInformation moduleItemMenu)) startUp

   320     "

   322     <resource: #menu>

   324     ^

   325      #(Menu

   326         (

   327          (MenuItem

   328             enabled: canBrowseSelectedClass

   329             label: 'Browse'

   330             itemValue: browseClass

   331             translateLabel: true

   332           )

   333          (MenuItem

   334             label: '-'

   335           )

   336          (MenuItem

   337             enabled: canCopyClassNameList

   338             label: 'Copy Version Info to Clipboard'

   339             itemValue: copyClassOrVMNameList

   340             translateLabel: true

   341           )

   342          )

   343         nil

   344         nil

   345       )

   346 !

   348 moduleMenu

   349     "This resource specification was automatically generated

   350      by the MenuEditor of ST/X."

   352     "Do not manually edit this!! If it is corrupted,

   353      the MenuEditor may not be able to read the specification."

   355     "

   356      MenuEditor new openOnClass:Tools::ObjectModuleInformation andSelector:#moduleMenu

   357      (Menu new fromLiteralArrayEncoding:(Tools::ObjectModuleInformation moduleMenu)) startUp

   358     "

   360     <resource: #menu>

   362     ^

   363      #(Menu

   364         (

   365          (MenuItem

   366             enabled: canBrowseSelectedModule

   367             label: 'Browse'

   368             itemValue: browseModule

   369             translateLabel: true

   370           )

   371          (MenuItem

   372             enabled: canCopyClassNameList

   373             label: 'Copy Version Info to Clipboard'

   374             itemValue: copyClassOrVMNameList

   375             translateLabel: true

   376           )

   377          (MenuItem

   378             label: '-'

   379           )

   380          (MenuItem

   381             enabled: canUnloadSelectedModule

   382             label: 'Remove Classes && Unload'

   383             itemValue: unloadSelectedModuleAndRemoveClasses

   384             translateLabel: true

   385           )

   386          (MenuItem

   387             enabled: canUnloadSelectedModule

   388             label: 'Unload'

   389             itemValue: unloadSelectedModule

   390             translateLabel: true

   391           )

   392          )

   393         nil

   394         nil

   395       )

   396 ! !

   398 !ObjectModuleInformation class methodsFor:'tableColumns specs'!

   400 tableColumns

   401     "This resource specification was automatically generated

   402      by the DataSetBuilder of ST/X."

   404     "Do not manually edit this!! If it is corrupted,

   405      the DataSetBuilder may not be able to read the specification."

   407     "

   408      DataSetBuilder new openOnClass:ObjectModuleInformation andSelector:#tableColumns

   409     "

   411     <resource: #tableColumns>

   413     ^#(

   414       (DataSetColumnSpec

   415          label: 'Name'

   416          activeHelpKey: ''

   417          labelButtonType: Button

   418          width: 0.5

   419          model: name

   420          canSelect: false

   421        )

   422       (DataSetColumnSpec

   423          label: 'Version'

   424          activeHelpKey: ''

   425          labelButtonType: Button

   426          model: version

   427          canSelect: false

   428        )

   429       (DataSetColumnSpec

   430          label: 'Date'

   431          activeHelpKey: ''

   432          labelButtonType: Button

   433          model: date

   434          canSelect: false

   435        )

   436       )

   438 !

   440 tableColumnsForSingleInfo

   441     "This resource specification was automatically generated

   442      by the DataSetBuilder of ST/X."

   444     "Do not manually edit this!! If it is corrupted,

   445      the DataSetBuilder may not be able to read the specification."

   447     "

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

   449     "

   451     <resource: #tableColumns>

   453     ^#(

   454       (DataSetColumnSpec

   455          label: ''

   456          activeHelpKey: ''

   457          labelButtonType: None

   458          width: 0.3

   459          model: name

   460          canSelect: false

   461        )

   462       (DataSetColumnSpec

   463          label: ''

   464          activeHelpKey: ''

   465          labelButtonType: None

   466          model: value

   467          canSelect: false

   468        )

   469       )

   471 ! !

   473 !ObjectModuleInformation methodsFor:'aspects'!

   475 canBrowseSelectedClass

   476     ^ [classNamesShown notEmptyOrNil

   477        and:[ self selectedInfoIndex notNil

   478        and:[ self selectedInfoIndex ~~ 0 ]]]

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

   481 !

   483 canBrowseSelectedModule

   484     canBrowseSelectedModule isNil ifTrue:[

   485         canBrowseSelectedModule := false asValue

   486     ].

   487     ^ canBrowseSelectedModule.

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

   490 !

   492 canCopyClassNameList

   493     ^ [table1VisibleHolder value

   494     and:[classInfoShown notEmptyOrNil or:[vmInfoShown notEmptyOrNil] ]]

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

   497 !

   499 canUnloadSelectedModule

   500     canUnloadSelectedModule isNil ifTrue:[

   501         canUnloadSelectedModule := false asValue

   502     ].

   503     ^ canUnloadSelectedModule.

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

   506 !

   508 infoTable1ListHolder

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

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

   512 !

   514 infoTable2ListHolder

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

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

   518 !

   520 listOfModuleNames

   521     listOfModuleNames isNil ifTrue:[

   522         listOfModuleNames := List new.

   523     ].

   524     ^ listOfModuleNames.

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

   527 !

   529 middleLabelHolder

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

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

   533 !

   535 notReadOnly

   536     ^ self readOnly not

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

   539 !

   541 readOnly

   542     ^ readOnly ? false

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

   545 !

   547 readOnly:aBoolean

   548     readOnly := aBoolean

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

   551 !

   553 selectedInfoIndex

   554     |sel|

   556     sel := self selectedInfoIndexHolder value.

   557     ^ sel

   558 !

   560 selectedInfoIndexHolder

   561     selectedInfoIndexHolder isNil ifTrue:[

   562         selectedInfoIndexHolder := ValueHolder new.

   563         selectedInfoIndexHolder onChangeSend:#selectedInfoIndexChanged to:self.

   564     ].

   565     ^ selectedInfoIndexHolder.

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

   568 !

   570 selectedModuleIndex

   571     |sel|

   573     sel := self selectedModuleIndexHolder value.

   574     ^ sel

   575 !

   577 selectedModuleIndexHolder

   578     selectedModuleIndexHolder isNil ifTrue:[

   579         selectedModuleIndexHolder := ValueHolder new.

   580         selectedModuleIndexHolder onChangeSend:#selectedModuleIndexChanged to:self.

   581     ].

   582     ^ selectedModuleIndexHolder.

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

   585 !

   587 showBuiltIn

   588     showBuiltIn isNil ifTrue:[

   589         showBuiltIn := true asValue.

   590         showBuiltIn onChangeSend:#filterChanged to:self.

   591     ].

   592     ^ showBuiltIn

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

   595 !

   597 showCObjects

   598     showCObjects isNil ifTrue:[

   599         showCObjects := true asValue.

   600         showCObjects onChangeSend:#filterChanged to:self.

   601     ].

   602     ^ showCObjects

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

   605 !

   607 showClassLibs

   608     showClassLibs isNil ifTrue:[

   609         showClassLibs := true asValue.

   610         showClassLibs onChangeSend:#filterChanged to:self.

   611     ].

   612     ^ showClassLibs

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

   615 !

   617 showMethods

   618     showMethods isNil ifTrue:[

   619         showMethods := true asValue.

   620         showMethods onChangeSend:#filterChanged to:self.

   621     ].

   622     ^ showMethods

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

   625 !

   627 showOthers

   628     showOthers isNil ifTrue:[

   629         showOthers := true asValue.

   630         showOthers onChangeSend:#filterChanged to:self.

   631     ].

   632     ^ showOthers

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

   635 !

   637 table1VisibleHolder

   638     table1VisibleHolder isNil ifTrue:[

   639         table1VisibleHolder := true asValue.

   640     ].

   641     ^ table1VisibleHolder.

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

   644 !

   646 table2VisibleHolder

   647     table2VisibleHolder isNil ifTrue:[

   648         table2VisibleHolder := false asValue.

   649     ].

   650     ^ table2VisibleHolder.

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

   653 ! !

   655 !ObjectModuleInformation methodsFor:'change & update'!

   657 selectedInfoIndexChanged

   658 !

   660 selectedModule

   661     |sel|

   663     sel := self selectedModuleIndex.

   664     sel isNil ifTrue:[^ nil].

   665     ^ objectHandles at:sel.

   666 !

   668 selectedModuleIndexChanged

   669     |module info|

   671     info := self selectedModuleInfo.

   672     module := self selectedModule.

   674     self canBrowseSelectedModule value:(info notNil and:[info ~~ #VM and:[module notNil]]).

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

   677     classNamesShown := nil.

   678     classInfoShown := nil.

   679     vmInfoShown := nil.

   681     info isNil ifTrue:[

   682         "/ selected a method, cObject or unknown

   683         self showInfoForNonClassLib:(self selectedModuleIndex).

   684         ^ self.

   685     ].

   686     info == #VM ifTrue:[

   687         "/ selected the pseudo entry for the VM itself

   688         self showInfoForVM.

   689         ^ self.

   690     ].

   691     "/ selected a class-library package

   692     self showInfoForClassLib:info.

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

   695 !

   697 selectedModuleInfo

   698     |sel info|

   700     sel := self selectedModuleIndex.

   701     sel notNil ifTrue:[

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

   703             info := allModules at:sel ifAbsent:nil.

   704         ].

   705     ].

   706     ^ info

   707 !

   709 showInfoForClassLib:info

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

   712     |rows|

   714     self middleLabelHolder value:'Contains Modules:'.

   716     classNamesShown := self shownClassNamesFor:info.

   718     rows := classNamesShown collect:[:cName |

   719                     |cls entry rev listEntry revisionInfo|

   721                     listEntry := InfoRow new.

   722                     listEntry name:cName.

   724                     cls := Smalltalk classNamed:cName.

   725                     cls isNil ifTrue:[

   726                         (cName endsWith:'_extensions') ifFalse:[

   727                             listEntry version:'(class removed)'.

   728                         ]

   729                     ] ifFalse:[

   730                         rev := cls binaryRevision.

   731                         rev notNil ifTrue:[

   732                             cls isLoaded ifFalse:[

   733                                 entry := '(stub for: ' , rev.

   734                             ] ifTrue:[

   735                                 entry :='(bin: ' , rev.

   736                             ].

   737                             cls revision ~= rev ifTrue:[

   738                                 entry := entry , ' / src: ' , (cls revision printString)

   739                             ].

   740                             entry := entry , ')'.

   741                             listEntry version:entry

   742                         ] ifFalse:[

   743                            cls revision notNil ifTrue:[

   744                                 listEntry version:'(overloaded by: ' , cls revision , ')'

   745                            ]

   746                         ].

   747                         revisionInfo := cls revisionInfo.

   748                         revisionInfo notNil ifTrue:[

   749                             listEntry date:(revisionInfo at:#date)

   750                         ].

   751                     ].

   752                     listEntry

   753                   ].

   755     classInfoShown := rows.

   757     self infoTable1ListHolder value:rows.

   758     self table1VisibleHolder value:true.

   759     self table2VisibleHolder value:false.

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

   762 !

   764 showInfoForNonClassLib:sel

   765     "/ selected a method, cObject or unknown

   767     |module fileName list entry|

   769     sel isNil ifTrue:[

   770         self table1VisibleHolder value:false.

   771         self table2VisibleHolder value:false.

   772         ^ self.

   773     ].

   775     module := objectHandles at:sel.

   776     fileName := module pathName.

   778     module isMethodHandle ifTrue:[

   779         |method nm entry1 entry2 entry3|

   781         self middleLabelHolder value:'Compiled Method:'.

   783         (method := module method) isNil ifTrue:[

   784             nm := '** removed **'.

   785         ] ifFalse:[

   786 "/            menu := PopUpMenu

   787 "/                        labels:#('Inspect' 'Browse')

   788 "/                        selectors:#(inspect browse).

   789 "/            menu actionAt:#inspect put:[ method inspect ].

   790 "/            menu actionAt:#browse put:[ |who|

   791 "/                                        who := method who.

   792 "/                                        UserPreferences systemBrowserClass

   793 "/                                            openInClass:(who methodClass)

   794 "/                                            selector:(who methodSelector)

   795 "/                                      ].

   796 "/            listView1 middleButtonMenu:menu.

   798             nm := (method whoString) asText emphasizeAllWith:(#color->Color blue).

   799         ].

   800         entry1 := InfoRow new.

   801         entry1 name:'Compiled method'; value:nm.

   803         entry2 := InfoRow new.

   804         entry2 name:'Path'; value:fileName.

   806         entry3 := InfoRow new.

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

   809         self infoTable2ListHolder value:(Array with:entry1 with:entry2 with:entry3).

   810         self table1VisibleHolder value:false.

   811         self table2VisibleHolder value:true.

   812         ^ self.

   813     ].

   815     (module isFunctionObjectHandle

   816     and:[module functions notEmpty]) ifTrue:[

   817         self middleLabelHolder value:'Functions:'.

   819 "/        menu := PopUpMenu

   820 "/                    labels:#('Inspect')

   821 "/                    selectors:#(inspect).

   822 "/        menu actionAt:#inspect put:[ module functions inspect  ].

   823 "/        listView1 middleButtonMenu:menu.

   824 "/

   825         list := (module functions select:[:f | f notNil])

   826                         collect:[:f | |entry|

   827                                         entry := InfoRow new.

   828                                         entry name:(f name asText emphasizeAllWith:(#color->Color blue)).

   829                                         entry value:('address: (16r) ' , (f code address hexPrintString leftPaddedTo:8 with:$0)).

   830                                         entry

   831                                 ].

   832         self infoTable2ListHolder value:list.

   833         self table1VisibleHolder value:false.

   834         self table2VisibleHolder value:true.

   835         ^ self.

   836     ].

   838     entry := InfoRow new.

   839     entry name:'Unknown'.

   840     self infoTable2ListHolder value:(Array with:entry).

   841     self table1VisibleHolder value:false.

   842     self table2VisibleHolder value:true.

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

   845 !

   847 showInfoForVM

   848     "/ show file versions in lower view.

   850     |l|

   852     self middleLabelHolder value:'Contains Modules:'.

   854     l := (ObjectMemory getVMIdentificationStrings).

   855     l := l select:[:entry | entry includesString:'$Header'].

   856     l := l select:[:entry | entry includesString:',v'].

   857     l := l collect:[:entry |

   858         |i1 i2 file revision date listEntry|

   860         listEntry := InfoRow new.

   862         i1 := entry indexOfSubCollection:'librun'.

   863         i1 ~~ 0 ifTrue:[

   864             i2 := entry indexOfSubCollection:',v' startingAt:i1.

   865             i2 ~~ 0 ifTrue:[

   866                 file := entry copyFrom:i1+7 to:(i2-1).

   867                 listEntry name:file.

   869                 i1 := i2+3.

   870                 i2 := entry indexOfSeparatorStartingAt:i1.

   871                 revision := entry copyFrom:i1 to:(i2-1).

   872                 listEntry version:revision.

   874                 i1 := i2+1.

   875                 i2 := entry indexOfSeparatorStartingAt:i1.

   876                 date := entry copyFrom:i1 to:(i2-1).

   877                 listEntry date:date.

   878             ].

   879         ].

   880         listEntry.

   881     ].

   883     vmInfoShown := l.

   884     self infoTable1ListHolder value:l.

   885     self table1VisibleHolder value:true.

   886     self table2VisibleHolder value:false.

   888 "/    readOnly ifFalse:[

   889 "/        unloadButton disable.

   890 "/        unloadAndRemoveButton disable.

   891 "/    ]

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

   894 !

   896 shownClassNamesFor:info

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

   899     |classNames|

   901     classNames := info classNames asSortedCollection.

   902     ^ classNames

   903         select:[:cName |

   904             |cls|

   906             cls := Smalltalk classNamed:cName.

   907             cls isNil ifTrue:[

   908                 true "a removed class"

   909             ] ifFalse:[

   910                 cls isPrivate not

   911             ].

   912         ].

   913 ! !

   915 !ObjectModuleInformation methodsFor:'initialization'!

   917 postBuildWith:aBuilder

   918     |canDoIt|

   920     super postBuildWith:aBuilder.

   922     canDoIt := ObjectFileLoader notNil and:[ObjectFileLoader canLoadObjectFiles].

   923     self showBuiltIn value:canDoIt.

   924     self showCObjects value:canDoIt.

   925     self showClassLibs value:canDoIt.

   926     self showMethods value:canDoIt.

   927     self showOthers value:canDoIt.

   929     self updateModuleList

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

   932 ! !

   934 !ObjectModuleInformation methodsFor:'menu actions'!

   936 browseClass

   937     |module info classNames selectedClassName selectedClass packageID methods|

   939     module := self selectedModule.

   940     info := self selectedModuleInfo.

   941     classNames := (self shownClassNamesFor:info) asSortedCollection.

   942     selectedClassName := classNames at:(self selectedInfoIndex).

   943     selectedClass := Smalltalk classNamed:selectedClassName.

   945     selectedClass notNil ifTrue:[

   946         Smalltalk browseInClass:selectedClass.

   947         ^ self.

   948     ].

   950     "/ clicked on an extensions-module ?

   951     (selectedClassName endsWith:'_extensions') ifTrue:[

   952         packageID := (selectedClassName copyWithoutLast:('_extensions' size)) asSymbol.

   953         methods := Smalltalk allExtensionsForPackage:packageID.

   954         (UserPreferences browserClass) browseMethods:methods title:('Extensions for ',packageID).

   955     ].

   956 self halt.

   957 !

   959 browseModule

   960     |module classes|

   962     module := self selectedModule.

   963     classes := module classNames collect:[:nm | Smalltalk classNamed:nm].

   964     UserPreferences systemBrowserClass

   965         browseClasses:classes

   966         label:(resources string:'Classes in %1' with:module libraryName)

   967 !

   969 copyClassOrVMNameList

   970     |text|

   972     text := ((classInfoShown ? vmInfoShown)collect:[:eachRow | eachRow infoString]) asStringCollection asString.

   973     self window setClipboardText:text.

   974 !

   976 menuUpdateModuleList

   977     self updateModuleList

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

   980 !

   982 openDocumentation

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

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

   986 !

   988 unloadSelectedModule

   989     self unloadSelectedModuleRemoveClasses:false

   990 !

   992 unloadSelectedModuleAndRemoveClasses

   993     self unloadSelectedModuleRemoveClasses:true

   994 !

   996 unloadSelectedModuleRemoveClasses:doRemoveClasses

   997     self withWaitCursorDo:[

   998         |info idx handle pathName|

  1000         info := self selectedModuleInfo.

  1001         handle := objectHandles at:(self selectedModuleIndex).

  1002         self selectedModuleIndexHolder value:nil.

  1004         info isNil ifTrue:[

  1005             "/ selected a method

  1006             "/ idx := idx - allModules size.

  1007             pathName := handle pathName.

  1008         ] ifFalse:[

  1009             "/ selected a package

  1010             pathName := info pathName.

  1011         ].

  1012         pathName notNil ifTrue:[

  1013             doRemoveClasses ifTrue:[

  1014                 ObjectFileLoader unloadObjectFileAndRemoveClasses:pathName.

  1015             ] ifFalse:[

  1016                 ObjectFileLoader unloadObjectFile:pathName.

  1017             ]

  1018         ].

  1019         self updateModuleList.

  1020     ]

  1021 ! !

  1023 !ObjectModuleInformation methodsFor:'private'!

  1025 filterChanged

  1026     self updateModuleList

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

  1029 !

  1031 updateModuleList

  1032     |showClassLibs showBuiltIn showMethods showCObjects showOthers

  1033      listOfModuleNames allObjects handles|

  1035     showClassLibs := self showClassLibs value.

  1036     showBuiltIn := self showBuiltIn value.

  1037     showMethods := self showMethods value.

  1038     showCObjects := self showCObjects value.

  1039     showOthers := self showOthers value.

  1041     listOfModuleNames := OrderedCollection new.

  1042     handles := OrderedCollection new.

  1044     allObjects := ObjectFileLoader loadedObjectHandles.

  1046     (showClassLibs or:[showBuiltIn]) ifTrue:[

  1047         |moduleNames|

  1049         allModules := ObjectMemory binaryModuleInfo asOrderedCollection.

  1050         (showBuiltIn and:[showClassLibs]) ifFalse:[

  1051             allModules := allModules select:

  1052                                         [:i |

  1053                                             |wantToSee|

  1055                                             wantToSee := i dynamic.

  1056                                             showBuiltIn ifTrue:[

  1057                                                 wantToSee := wantToSee not

  1058                                             ].

  1059                                             wantToSee

  1060                                         ]

  1061         ].

  1063         "/ sorting by reverse id brings newest ones to the top (a side effect)

  1064         allModules sort:[:a :b | (a id) > (b id)].

  1065         moduleNames := allModules collect:[:entry | entry name].

  1066         listOfModuleNames addAll:moduleNames.

  1067         handles addAll:allModules.

  1068     ].

  1070     showMethods ifTrue:[

  1071         |methodObjects methodNames|

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

  1074         methodNames := methodObjects collect:[:mH | mH method isNil ifTrue:[

  1075                                                         'compiled method - removed' " , ' (in ' , mH pathName , ')' "

  1076                                                     ] ifFalse:[

  1077                                                         'compiled method ' , mH method whoString  " , ' (in ' , mH pathName , ')' "

  1078                                                     ].

  1079                                              ].

  1080         listOfModuleNames addAll:methodNames.

  1081         handles addAll:methodObjects.

  1082     ].

  1084     showCObjects ifTrue:[

  1085         |cObjects cObjectNames|

  1087         cObjects := (allObjects select:[:h | h isFunctionObjectHandle]) asArray.

  1088         cObjectNames := cObjects collect:[:entry | entry pathName].

  1089         listOfModuleNames addAll:cObjectNames.

  1090         handles addAll:cObjects.

  1091     ].

  1093     showOthers ifTrue:[

  1094         |otherObjects otherObjectNames|

  1096         otherObjects := (allObjects select:[:h | (h isFunctionObjectHandle

  1097                                                  or:[h isMethodHandle

  1098                                                  or:[h isClassLibHandle]]) not]) asArray.

  1099         otherObjectNames := otherObjects collect:[:entry | entry pathName].

  1100         listOfModuleNames addAll:otherObjectNames.

  1101         handles addAll:otherObjects.

  1102     ].

  1104     showBuiltIn ifTrue:[

  1105         listOfModuleNames addFirst:'VM'.

  1106         handles addFirst:#VM.

  1107         allModules addFirst:#VM.

  1108     ].

  1110     self listOfModuleNames contents:listOfModuleNames.

  1111     objectHandles := handles.

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

  1114 ! !

  1116 !ObjectModuleInformation::InfoRow methodsFor:'accessing'!

  1118 date

  1119     ^ date

  1120 !

  1122 date:something

  1123     date := something.

  1124 !

  1126 name

  1127     ^ name

  1128 !

  1130 name:something

  1131     name := something.

  1132 !

  1134 name:nameArg version:versionArg date:dateArg

  1135     name := nameArg.

  1136     version := versionArg.

  1137     date := dateArg.

  1138 !

  1140 value

  1141     ^ value

  1142 !

  1144 value:something

  1145     value := something.

  1146 !

  1148 version

  1149     ^ version

  1150 !

  1152 version:something

  1153     version := something.

  1154 ! !

  1156 !ObjectModuleInformation::InfoRow methodsFor:'info'!

  1158 infoString

  1159     ^ name , ' ', (version ? '-') , ' ', (date ? '-') printString

  1160 ! !

  1162 !ObjectModuleInformation class methodsFor:'documentation'!

  1164 version

  1165     ^ '$Header$'

  1166 ! !

author	Claus Gittinger <cg@exept.de>
	Wed, 29 Jul 2009 20:02:02 +0200
changeset 2570	4e663bc64364
parent 2403	11c5c82a852c
child 2616	01e597429c47
permissions	-rw-r--r--