The Trunk: SystemReporter-laza.1.mcz

David T. Lewis uploaded a new version of SystemReporter to project The Trunk:
http://source.squeak.org/trunk/SystemReporter-laza.1.mcz

==================== Summary ====================

Name: SystemReporter-laza.1
Author: laza
Time: 17 January 2011, 1:57:05.447 pm
UUID: 8a8f5bba-a04d-e74d-a103-09f68b35baed
Ancestors:

Initial checkin

==================== Snapshot ====================

SystemOrganization addCategory: #SystemReporter!

Object subclass: #SystemReporter
        instanceVariableNames: 'categories categoriesSelected report'
        classVariableNames: ''
        poolDictionaries: ''
        category: 'SystemReporter'!

!SystemReporter commentStamp: 'laza 1/17/2011 13:37' prior: 0!
SystemReporter offers a window where information about the system is gathered. This can be easily copied to the clipboard and be attached to a bug report for better identification of the context the bug occured in.

To extend the SystemReporter:
        - add a method reportXYZ:aStream to the reporting category
        - add an association like XYZ->reportXYZ to the initialize method
!

----- Method: SystemReporter classSide>>open (in category 'instance creation') -----
open
        ^ ToolBuilder open: self new.!

----- Method: SystemReporter>>buildCategoriesWith: (in category 'building') -----
buildCategoriesWith: aBuilder
        ^ aBuilder pluggableMultiSelectionListSpec new
                model: self;
                list: #categoryList;
                menu: #categoryMenu:;
                getIndex: #categorySelected;
                setIndex: #categorySelected:;
                getSelectionList: #categoryAt:;
                setSelectionList: #categoryAt:put:;
                yourself.!

----- Method: SystemReporter>>buildReportWith: (in category 'building') -----
buildReportWith: aBuilder
        ^ aBuilder pluggableTextSpec new
                model: self;
                menu: #reportMenu:;
                getText: #reportText;
                yourself.!

----- Method: SystemReporter>>buildWith: (in category 'building') -----
buildWith: aBuilder
        | window |
        window := aBuilder pluggableWindowSpec new
                model: self; label: self label; extent: self extent;
                children: (OrderedCollection new
                        add: ((self buildCategoriesWith: aBuilder)
                                frame: self categoriesFrame;
                                yourself);
                        add: ((self buildReportWith: aBuilder)
                                frame: self reportFrame;
                                yourself);
                        yourself);
                yourself.
        ^ aBuilder build: window.!

----- Method: SystemReporter>>categoriesFrame (in category 'building') -----
categoriesFrame
        ^LayoutFrame new
                leftFraction: 0 offset: 0;
                topFraction: 0 offset: 0;
                rightFraction: 0.25 offset: 0;
                bottomFraction: 1 offset: 0!

----- Method: SystemReporter>>categoryAt: (in category 'accessing-categories') -----
categoryAt: anIndex
        ^ categoriesSelected includes: (self categoryList at: anIndex ifAbsent: [ ^ false ]).!

----- Method: SystemReporter>>categoryAt:put: (in category 'accessing-categories') -----
categoryAt: anInteger put: aBoolean
        categoriesSelected := categoriesSelected
                perform: (aBoolean ifTrue: [ #copyWith: ] ifFalse: [ #copyWithout: ])
                with: (self categoryList at: anInteger ifAbsent: [ ^ self ]).
        self updateReport!

----- Method: SystemReporter>>categoryList (in category 'accessing-categories') -----
categoryList
        ^ categories keys!

----- Method: SystemReporter>>categoryMenu: (in category 'accessing-categories') -----
categoryMenu: aMenu
        ^ aMenu
                title: 'Categories';
                add: 'Select all' action: #selectAllCategories;
                add: 'Select inversion' action: #selectInverseCategories;
                add: 'Select none' action: #selectNoCategories;
                addLine;
                add: 'Filter...' action: #filterCategories;
                addLine;
                add: 'Refresh' action: #updateCategories;
                yourself.!

----- Method: SystemReporter>>categorySelected (in category 'accessing-categories') -----
categorySelected
        ^ 0!

----- Method: SystemReporter>>categorySelected: (in category 'accessing-categories') -----
categorySelected: anInteger
        self changed: #categorySelected.!

----- Method: SystemReporter>>extent (in category 'accessing-ui') -----
extent
        ^ 640 @ 480!

----- Method: SystemReporter>>header:on: (in category 'printing-report') -----
header: aString on: aStream
        aStream nextPutAll: aString; cr.
        aString size timesRepeat: [aStream nextPut: $-].
        aStream cr!

----- Method: SystemReporter>>initialize (in category 'initialize-release') -----
initialize
        categories := IdentityDictionary new
                add: #Image -> #reportImage;
                add: #'OS General' -> #reportOS;
                add: #'VM General' -> #reportVM;
                add: #Modules -> #reportModules;
                yourself.
        Smalltalk os platformName = 'Win32' ifTrue: [
                categories
                        add: #'Hardware Details' -> #reportHardwareDetails;
                        add: #'Operating System Details' -> #reportOSDetails;
                        add: #'Graphics Hardware Details' -> #reportGFXDetails
                        ].
        categoriesSelected := Set with: #Image with: #'VM General'.
        self updateReport
!

----- Method: SystemReporter>>label (in category 'accessing-ui') -----
label
        ^ 'System Reporter' !

----- Method: SystemReporter>>reportFrame (in category 'building') -----
reportFrame
        ^LayoutFrame new
                leftFraction: 0.25 offset: 0;
                topFraction: 0 offset: 0;
                rightFraction: 1 offset: 0;
                bottomFraction: 1 offset: 0!

----- Method: SystemReporter>>reportGFXDetails: (in category 'reporting') -----
reportGFXDetails: aStream
        self header: 'Graphics Hardware Details' on: aStream.
        aStream
                tab; nextPutAll: (SmalltalkImage current getSystemAttribute: 10003); cr!

----- Method: SystemReporter>>reportHardwareDetails: (in category 'reporting') -----
reportHardwareDetails: aStream
        self header: 'Hardware Details' on: aStream.
        aStream
                tab; nextPutAll: (SmalltalkImage current getSystemAttribute: 10001); cr!

----- Method: SystemReporter>>reportImage: (in category 'reporting') -----
reportImage: aStream
        | id value |
        self header: 'Image' on: aStream.
        aStream
                tab; nextPutAll: SystemVersion current version; cr;
                tab; nextPutAll: SmalltalkImage current lastUpdateString; cr;
                tab; nextPutAll: SmalltalkImage current currentChangeSetString; cr;
                tab; nextPutAll: (SmalltalkImage current getSystemAttribute: 1); cr.
        id := 3.
        [value := (SmalltalkImage current getSystemAttribute: id).
        value = nil or: [id > 1000]] whileFalse: [
                aStream nextPutAll: value; space.
                id := id + 1
        ].
!

----- Method: SystemReporter>>reportModules: (in category 'reporting') -----
reportModules: aStream
        self header: 'Loaded Modules' on: aStream.
        SmalltalkImage current listLoadedModules do: [:each | aStream tab; nextPutAll: each; cr].

!

----- Method: SystemReporter>>reportOS: (in category 'reporting') -----
reportOS: aStream
        self header: 'Operating System/Hardware' on: aStream.
        aStream
                tab; nextPutAll: (SmalltalkImage current getSystemAttribute: 1001); space;
                tab; nextPutAll: (SmalltalkImage current getSystemAttribute: 1002); space;
                tab; nextPutAll: (SmalltalkImage current getSystemAttribute: 1003).
!

----- Method: SystemReporter>>reportOSDetails: (in category 'reporting') -----
reportOSDetails: aStream
        self header: 'Operating System Details' on: aStream.
        aStream
                tab; nextPutAll: (SmalltalkImage current getSystemAttribute: 10002); cr!

----- Method: SystemReporter>>reportText (in category 'accessing-report') -----
reportText
        ^ (report isNil or: [categoriesSelected isEmpty])
                ifTrue: ['-- empty --']
                ifFalse: [report]!

----- Method: SystemReporter>>reportVM: (in category 'reporting') -----
reportVM: aStream
        | id value |
        self header: 'Virtual Machine' on: aStream.
        aStream
                tab; nextPutAll: (SmalltalkImage current getSystemAttribute: 1004); cr;
                tab; nextPutAll: (SmalltalkImage current getSystemAttribute: 0); cr.
        aStream tab.
                id := -1.
                [value := (SmalltalkImage current getSystemAttribute: id).
                value = nil or: [id < -1000]] whileFalse: [
                        aStream nextPutAll: value; space.
                        id := id - 1
                ].
!

----- Method: SystemReporter>>updateReport (in category 'updating') -----
updateReport
        report := String streamContents: [:stream |  
                self categoryList do: [:each |
                        (categoriesSelected includes: each) ifTrue: [
                                self perform: ((categories at: each), ':') asSymbol with: stream.
                                stream cr; cr]]].
        self changed: #reportText!