Squeak 4.6: SystemReporter-mt.24.mcz

Previous Topic Next Topic
 
classic Classic list List threaded Threaded
1 message Options
Reply | Threaded
Open this post in threaded view
|

Squeak 4.6: SystemReporter-mt.24.mcz

commits-2
Chris Muller uploaded a new version of SystemReporter to project Squeak 4.6:
http://source.squeak.org/squeak46/SystemReporter-mt.24.mcz

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

Name: SystemReporter-mt.24
Author: mt
Time: 18 May 2015, 10:16:53.323 am
UUID: 8a99a2df-13ea-6149-bcad-cb460f6c8e6b
Ancestors: SystemReporter-dtl.23

Fixed confirm-actions for all longer lasting operations in the system reporter: space analysis, tiny benchmarks, test runner. Support 'cancel' for all of them.

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

SystemOrganization addCategory: #SystemReporter!

Object subclass: #SystemReporter
        instanceVariableNames: 'categories categoriesSelected report tinyBenchmarksResult categoryList testRunner spaceAnalysisResult'
        classVariableNames: ''
        poolDictionaries: ''
        category: 'SystemReporter'!

!SystemReporter commentStamp: 'laza 1/18/2011 12:04' 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
        - insert a line
                add: #XYZ method: #reportXYZ
          to the initialize method
!

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

----- Method: SystemReporter>>add:method: (in category 'accessing-categories') -----
add: category method: aSymbol
        ^self categoryList add: (self categories add: category -> aSymbol) key!

----- 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>>categories (in category 'accessing-categories') -----
categories
        ^ categories ifNil: [categories := IdentityDictionary new]!

----- 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
        ^ categoryList ifNil: [categoryList := OrderedCollection new]!

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

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

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

----- Method: SystemReporter>>copyReportToClipboard (in category 'accessing-report') -----
copyReportToClipboard
        Clipboard clipboardText: self reportText.
        UIManager default inform: 'Copied Report to Clipboard'!

----- Method: SystemReporter>>enumerate:on: (in category 'private') -----
enumerate: aBlock on: aStream
        self enumerate: aBlock startAt: 0 on: aStream!

----- Method: SystemReporter>>enumerate:startAt:on: (in category 'private') -----
enumerate: aBlock startAt: first on: aStream
        "Utilitymethod to enumerate Options or Parameters from first to 1000"
        | idx value |
        idx := first.
        [value := aBlock value: idx.
        value = nil or: [idx > 1000]] whileFalse: [
                aStream
                        nextPut: $#;
                        nextPutAll: idx printString;
                        tab;
                        nextPutAll: value; cr.
                idx := idx + 1
        ].
        idx = first ifTrue: [aStream nextPutAll: 'none'; cr]!

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

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

----- Method: SystemReporter>>initialize (in category 'initialize-release') -----
initialize
        self
                add: #Image method: #reportImage;
                add: #'Image Parameters' method: #reportImageParameters;
                add: #'Image Sources' method: #reportSources;
                add: #'Image Preferences' method: #reportPreferences;
                add: #'MC Repositories' method: #reportRepositories;
                add: #'MC Working Copies' method: #reportWorkingCopies;
                add: #'VM General' method: #reportVM;
                add: #'VM Options' method: #reportVMOptions;
                add: #'VM Modules' method: #reportModules;
                add: #'VM Parameters' method: #reportVMParameters;
                add: #'VM Stats' method: #reportVMStats.
        Smalltalk os platformName = 'Win32' ifTrue: [
                self
                        add: #'VM Configuration' method: #reportWin32VMConfig.
                ].
        self
                add: #'OS General' method: #reportOS.
        Smalltalk os platformName = 'Win32' ifTrue: [
                self
                        add: #'OS Details' method: #reportWin32OSDetails;
                        add: #'Hardware Details' method: #reportWin32HardwareDetails;
                        add: #'GFX Hardware Details' method: #reportWin32GFXDetails.
                ].
        Smalltalk os osVersion = 'linux' ifTrue: [
                self
                        add: #'OS Details' method: #reportLinuxOSDetails
        ].
        self
                add: #'Tiny Benchmarks' method: #reportTinyBenchmarks;
                add: #'Space Analysis' method: #reportSpaceAnalysis;
                add: #'SUnit' method: #reportTestRunner;
                add: #'Debug Log' method: #reportDebugLog.
        categoriesSelected := Set with: #Image with: #'VM General'.
        self updateReport
!

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

----- Method: SystemReporter>>printDebugExpressionFor:on: (in category 'private') -----
printDebugExpressionFor: methodSignature on: aStream
        | compiledMethod |
        compiledMethod := Compiler evaluate: methodSignature.
        aStream
                 nextPut: $( ;
                 nextPutAll: compiledMethod methodClass name ;
                 nextPutAll: ' selector: #' ;
                 nextPutAll: compiledMethod selector ;
                 nextPutAll: ') debug.'!

----- Method: SystemReporter>>refresh (in category 'accessing-categories') -----
refresh
        spaceAnalysisResult := tinyBenchmarksResult := testRunner := nil.
        self updateReport!

----- Method: SystemReporter>>reportDebugLog: (in category 'reporting') -----
reportDebugLog: aStream
        | logFilename logStream contents |
        self header: 'Debug Logfile' on: aStream.
        logFilename := Smalltalk image squeakErrorFileName.
        logStream := nil.
        [
                [
                        logStream := FileStream readOnlyFileNamed: logFilename.
                        aStream nextPutAll: logStream name; cr; cr.
                        contents := logStream contents.
                        aStream
                                nextPutAll:
                                        ((contents isNil or: [contents size = 0])
                                                ifTrue: ['<empty>']
                                                ifFalse: [contents]);
                                cr
                ] on: Error do: [:ex |
                        aStream
                                nextPutAll: (
                                        ex class = FileDoesNotExistException
                                                ifTrue: [logFilename, ' not found']
                                                ifFalse: [ex description]);
                                cr
                ]
        ] ensure: [
                logStream ifNotNil: [logStream close]
        ]!

----- 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>>reportImage: (in category 'reporting') -----
reportImage: aStream
        self header: 'Image' on: aStream.
        aStream
                nextPutAll: Smalltalk image imageName; cr;
                nextPutAll: SystemVersion current version; cr;
                nextPutAll: Smalltalk image lastUpdateString; cr;
                nextPutAll: Smalltalk image currentChangeSetString; cr.
        [ | imageFormat bitsPerWord |
        imageFormat := Smalltalk image imageFormatVersion.
        bitsPerWord := Smalltalk image wordSize * 8.
        aStream nextPutAll: 'Image format ';
                        nextPutAll: imageFormat asString;
                        nextPutAll: ' (';
                        nextPutAll: bitsPerWord asString;
                        nextPutAll: ' bit)'; cr]
                on: Warning
                do: ["primitive not present in VM"].
!

----- Method: SystemReporter>>reportImageParameters: (in category 'reporting') -----
reportImageParameters: aStream
        self header: 'Image Commandline Parameters' on: aStream.
        self enumerate: [:idx | Smalltalk image argumentAt: idx] on: aStream.!

----- Method: SystemReporter>>reportLinuxOSDetails: (in category 'reporting') -----
reportLinuxOSDetails: aStream
        self header: 'Operating System Details' on: aStream.
        #(
                '/etc/issue'
                '/etc/lsb-release'
                '/proc/version'
        ) do: [:path|
                self writeContentsSafelyFromFile: path on: aStream]!

----- Method: SystemReporter>>reportMenu: (in category 'accessing-report') -----
reportMenu: aMenu
        ^ aMenu
                title: 'Report';
                add: 'Copy to Clipboard' action: #copyReportToClipboard;
                yourself.!

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

!

----- Method: SystemReporter>>reportOS: (in category 'reporting') -----
reportOS: aStream
        self header: 'Operating System/Hardware' on: aStream.
        aStream
                nextPutAll: Smalltalk os platformName; space;
                nextPutAll: Smalltalk os osVersion; space;
                nextPutAll: Smalltalk os platformSubtype; cr
!

----- Method: SystemReporter>>reportPreferences: (in category 'reporting') -----
reportPreferences: aStream
        | booleanPrefs prefs valuePrefs attribute falseTA trueTA |
        prefs := Preferences dictionaryOfPreferences.
        booleanPrefs := prefs select: [:each | each type = #Boolean].
        valuePrefs := prefs select: [:each | each type = #Number or: [each type = #String]].
        trueTA := TextColor black.
        falseTA := TextColor gray.
        booleanPrefs := booleanPrefs asSortedCollection: [:a :b | a name <= b name].  
        self header: 'Boolean Preferences' on: aStream.
        booleanPrefs do: [:each |
                attribute := each preferenceValue ifTrue: [trueTA] ifFalse: [falseTA].
                aStream withAttribute: attribute do: [
                aStream
                        nextPutAll: each name;
                        tab;  
                        nextPutAll: each preferenceValue printString;
                        cr]].
        aStream cr.
        self header: 'Value Preferences' on: aStream.
        valuePrefs do: [:each |
                aStream
                        nextPutAll: each name;
                        tab;  
                        nextPutAll: each preferenceValue printString;
                        cr].
!

----- Method: SystemReporter>>reportRepositories: (in category 'reporting') -----
reportRepositories: aStream
        self header: 'Monticello Repositories' on: aStream.
        MCRepositoryGroup default repositories do: [:each | aStream nextPutAll: each description; cr]!

----- Method: SystemReporter>>reportSources: (in category 'reporting') -----
reportSources: aStream
        self header: 'Image Sources' on: aStream.
        aStream nextPutAll: SourceFiles class printString; cr.
        SourceFiles do: [:each |
                each ifNotNil: [aStream nextPutAll: each printString; cr]]!

----- Method: SystemReporter>>reportSpaceAnalysis: (in category 'reporting') -----
reportSpaceAnalysis: aStream

        spaceAnalysisResult ifNil: [
                (UIManager default
                        confirm: 'Running the space analysis\might take a few seconds.' withCRs translated
                        title: 'Continue?' translated)
                                ifFalse: [
                                        categoriesSelected remove: #'Space Analysis'.
                                        ^ self changed: #categorySelected ].
               
                spaceAnalysisResult := String streamContents: [ :stream |
                        SpaceTally new printSpaceAnalysis: 1 onStream: stream ] ].
        self header: 'Space Analysis' on: aStream.
        aStream nextPutAll: spaceAnalysisResult; cr!

----- Method: SystemReporter>>reportTestRunner: (in category 'reporting') -----
reportTestRunner: aStream
       
        testRunner ifNil: [
                (UIManager default
                        confirm: 'Running all tests might\take a some minutes.' withCRs translated
                        title: 'Continue?')
                                ifTrue: [ testRunner := TestRunner new runAll ]
                                ifFalse:
                                        [ categoriesSelected remove: #SUnit.
                                        ^ self changed: #categorySelected ] ].
        self
                header: 'SUnit Results'
                on: aStream.
        aStream nextPutAll: testRunner statusText ; cr ; cr.
        self
                header: 'Failed Tests'
                on: aStream.
        testRunner failedList do:
                [ : each | self
                        printDebugExpressionFor: each
                        on: aStream.
                aStream cr ].
        aStream cr.
        self
                header: 'Errors'
                on: aStream.
        testRunner errorList do:
                [ : each | self
                        printDebugExpressionFor: each
                        on: aStream.
                aStream cr ]!

----- Method: SystemReporter>>reportText (in category 'accessing-report') -----
reportText
        ^ (report isNil or: [categoriesSelected isEmpty])
                ifTrue: ['-- Choose any category on the left --']
                ifFalse: [report]!

----- Method: SystemReporter>>reportTinyBenchmarks: (in category 'reporting') -----
reportTinyBenchmarks: aStream
        tinyBenchmarksResult ifNil: [
                (UIManager default
                        confirm: 'Running all benchmarks\might take a few seconds.' withCRs translated
                        title: 'Continue?' translated)
                                ifFalse: [
                                        categoriesSelected remove: #'Tiny Benchmarks'.
                                        ^ self changed: #categorySelected ].
                Cursor wait showWhile: [tinyBenchmarksResult := 0 tinyBenchmarks]].
        self header: 'Tiny Benchmarks' on: aStream.
        aStream nextPutAll: tinyBenchmarksResult; cr!

----- Method: SystemReporter>>reportVM: (in category 'reporting') -----
reportVM: aStream
        self header: 'Virtual Machine' on: aStream.
        aStream
                nextPutAll: (Smalltalk vm vmFileName); cr;
                nextPutAll: (Smalltalk vm vmVersion); cr.
        Smalltalk vm buildDate
                ifNotNilDo: [:string | aStream nextPutAll: string; cr].
        [Smalltalk vm platformSourceVersion
                ifNotNilDo: [:v | aStream nextPutAll: 'platform sources revision ', v; cr]]
                        on: Warning do: ["unsupported primitive"].
        [Smalltalk vm interpreterSourceVersion
                ifNotNilDo: [:v | aStream nextPutAll: 'VMMaker versionString ', v; cr]]
                        on: Warning do: ["unsupported primitive"].
        [Smalltalk vm interpreterClass
                ifNotNilDo: [:string | aStream nextPutAll: string; cr].
        Smalltalk vm cogitClass
                ifNotNilDo: [:string | aStream nextPutAll: string; cr]
        ] on: Error do: ["unsupported primitives"]
!

----- Method: SystemReporter>>reportVMOptions: (in category 'reporting') -----
reportVMOptions: aStream
        self header: 'Virtual Machine Commandline Options' on: aStream.
        self enumerate: [:idx | Smalltalk vm optionAt: idx] startAt: 1 on: aStream!

----- Method: SystemReporter>>reportVMParameters: (in category 'reporting') -----
reportVMParameters: aStream
        | vmParameters isCog isSpur |
        self header: 'Virtual Machine Parameters' on: aStream.
        vmParameters := Smalltalk vm getVMParameters.
        isCog := (vmParameters at: 41 ifAbsent: [0]) anyMask: 1. "determine Cog/Stack via bit 0, requires native float order."
        isSpur := isCog and: [(vmParameters at: 41 ifAbsent: [0]) anyMask: 2r10000]. "bit 16 is the Spur bit"
        (isSpur
                ifFalse:
                        [#( 1 'size of old space'
                                2 'size of young+old space'
                                3 'size of memory')]
                ifTrue:
                        [#( 1 'size of old space'
                                2 'size of new space'
                                3 'size of heap')]),
        (isSpur
                ifFalse:
                        [#( 4 'allocationCount'
                                5 'allocations between GCs'
                                6 'survivor count tenuring threshold')]
                ifTrue: [#()]),
        #( 7 'full GCs since startup'
                8 'total milliseconds in full GCs since startup'),
        (isSpur
                ifFalse: [#( 9 'incremental GCs since startup'
                                        10 'total milliseconds in incremental GCs since startup')]
                ifTrue: [#( 9 'scavenging GCs since startup'
                                        10 'total milliseconds in scavenging GCs since startup')]),
        #( 11 'tenures of surving objects since startup'),
        (isCog
                ifFalse:
                        [#( 12 'specific to the translating VM'
                                13  'specific to the translating VM'
                                14  'specific to the translating VM'
                                15  'specific to the translating VM'
                                16  'specific to the translating VM'
                                17  'specific to the translating VM'
                                18  'specific to the translating VM'
                                19  'specific to the translating VM'
                                20  'specific to the translating VM')]
                ifTrue:
                        [{12 to: 20. 'specific to the translating VM'}]),
        #( 21 'root table size'
                22 'root table overflows since startup'
                23 'bytes of extra memory to reserve for VM buffers, plugins, etc.'
                24 'memory threshold above which shrinking object memory'
                25 'memory headroom when growing object memory'),
        (isCog
                ifFalse:
                        [#( 26  'interruptChecksEveryNms - force an ioProcessEvents every N milliseconds, in case the image  is not calling getNextEvent often')]
                ifTrue:
                        [#( 26  'heartbeat period (ms)')]),
        (isSpur
                ifFalse:
                        [#( 27 'number of times mark loop iterated for current IGC/FGC includes ALL marking'
                                28 'number of times sweep loop iterated  for current IGC/FGC'
                                29 'number of times make forward loop iterated for current IGC/FGC'
                                30 'number of times compact move loop iterated for current IGC/FGC')]
                ifTrue: [#()]),
        #( 31 'number of grow memory requests'
                32 'number of shrink memory requests'),
        (isSpur
                ifFalse:
                        [#( 33 'number of root table entries used for current IGC/FGC'
                                34 'number of allocations done before current IGC/FGC'
                                35 'number of survivor objects after current IGC/FGC'
                                36  'millisecond clock when current IGC/FGC completed'
                                37  'number of marked objects for Roots of the world, not including Root Table entries for current IGC/FGC'
                                38  'milliseconds taken by current IGC '
                                39  'Number of finalization signals for Weak Objects pending when current IGC/FGC completed')]
                ifTrue:
                        [#( 36  'millisecond clock when current SGC/FGC completed'
                                38  'milliseconds taken by current SGC '
                                39  'Number of finalization signals for Weak Objects pending when current SGC/FGC completed')]),
        #( 40  'VM word size - 4 or 8'),
        (isCog
                ifTrue:
                        [#(
                                41 'imageFormatVersion for the VM'
                                42 'number of stack pages in use'
                                43 'desired number of stack pages (stored in image file header, max 65535)'
                                44 'size of eden, in bytes'
                                45 'desired size of eden, in bytes (stored in image file header)'
                                46 'machine code zone size, in bytes'
                                47 'desired machine code zone size (0 => default 1Mb)'
                                48 'various header flags.  See getCogVMFlags.'
                                49 'max size the image promises to grow the external semaphore table to'),
                        (isSpur
                                ifFalse:
                                        [{ 50 to: 54. 'reserved for VM parameters that persist in the image (such as size of eden above)'.
                                                55 to: 56. 'specific to Spur' }]
                                ifTrue:
                                        [{ 50 to: 53. 'reserved for VM parameters that persist in the image (such as size of eden above)' },
                                        #( 54 'total free old space'
                                                55 'ratio of growth and image size at or above which a GC will be performed post scavenge')]),
                        #( 56 'number of process switches since startup'
                                57 'number of ioProcessEvents calls since startup'
                                58 'number of forceInterruptCheck calls since startup'
                                59 'number of check event calls since startup'
                                60 'number of stack page overflows since startup'
                                61 'number of stack page divorces since startup'
                                62 'compiled code compactions since startup'
                                63 'total milliseconds in compiled code compactions since startup'
                                64 'the number of methods that currently have jitted machine-code'
                                65 'whether the VM supports MULTIPLE_BYTECODE_SETS or not.'
                                66 'the byte size of a stack page'),
                        { 67 to: 69. 'reserved for more Cog-related info' },
                        #( 70 'the vmProxyMajorVersion (the interpreterProxy VM_MAJOR_VERSION)'
                                71 'the vmProxyMinorVersion (the interpreterProxy VM_MINOR_VERSION)')]
                ifFalse:
                        [#()])
        pairsDo: [:idx :desc | | value values |
                aStream nextPut: $#.
                idx isInteger
                        ifTrue:
                                [value := vmParameters at: idx.
                                 aStream print: idx; tab; nextPutAll: ((value isInteger and: [idx ~= 41]) ifTrue: [value asStringWithCommas] ifFalse: [value printString])]
                        ifFalse:
                                [value := vmParameters at: idx first.
                                 aStream print: idx first; next: 2 put: $.; print: idx last; tab.
                                 values := idx collect: [:i| vmParameters at: i].
                                 values asSet size = 1
                                        ifTrue: [aStream print: value]
                                        ifFalse: [values do: [:v| aStream print: v] separatedBy: [aStream nextPutAll: ', ']]].
                aStream tab; nextPutAll: desc; cr]!

----- Method: SystemReporter>>reportVMStats: (in category 'reporting') -----
reportVMStats: aStream
        self header: 'Virtual Machine Statistics' on: aStream.
        aStream
                nextPutAll: Smalltalk vm vmStatisticsReportString!

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

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

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

----- Method: SystemReporter>>reportWin32VMConfig: (in category 'reporting') -----
reportWin32VMConfig: aStream
        | exePath iniPath |
        self header: 'VM Configuration' on: aStream.
        exePath := Smalltalk vm vmFileName.
        iniPath := (exePath copyUpToLast: $.), '.ini'.
        aStream nextPutAll: iniPath; cr.
        self writeContentsSafelyFromFile: iniPath on: aStream.
!

----- Method: SystemReporter>>reportWorkingCopies: (in category 'reporting') -----
reportWorkingCopies: aStream
        | list |
        self header: 'Monticello Working Copies' on: aStream.
        list := MCWorkingCopy allManagers asSortedCollection: [:a :b | a name <= b name]  .
        list do: [:each | aStream nextPutAll: each description; cr]!

----- Method: SystemReporter>>selectAllCategories (in category 'accessing-categories') -----
selectAllCategories
        categoriesSelected addAll: categoryList.
        self changed: #categorySelected.
        self updateReport!

----- Method: SystemReporter>>selectNoCategories (in category 'accessing-categories') -----
selectNoCategories
        categoriesSelected removeAll.
        self changed: #categorySelected.
        self updateReport!

----- Method: SystemReporter>>updateReport (in category 'updating') -----
updateReport
        report := Text streamContents: [:stream |
                stream
                        withAttribute: (TextFontReference toFont: ((TextStyle named: 'BitstreamVeraSansMono') fontOfSize: 16))
                        do: [
                                self categoryList do: [:each |
                                        (categoriesSelected includes: each) ifTrue: [
                                                self perform: ((categories at: each), ':') asSymbol with: stream.
                                                stream cr]]]].
        self changed: #reportText!

----- Method: SystemReporter>>writeContentsSafelyFromFile:on: (in category 'private') -----
writeContentsSafelyFromFile: osPath on: aStream
        aStream nextPutAll:
                ([
                        (FileStream readOnlyFileNamed: osPath) upToEnd
                 ] on: Error do: [:ex| ex return: ex printString])!