[squeak-dev] The Trunk: SystemReporter-laza.1.mcz

commits at source.squeak.org commits at source.squeak.org
Wed Jan 19 23:32:43 UTC 2011


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!




More information about the Squeak-dev mailing list