From 9a21ade6c6ae3408235de3b3c7615415e9b57796 Mon Sep 17 00:00:00 2001
From: Alistair Grant <alistairgrant@fastmail.com.au>
Date: Thu, 19 Dec 2024 15:15:16 +0100
Subject: [PATCH] [feenkcom/gtoolkit#4254] Include the GT image version number
 in PharoDebug.log

---
 .../Context.extension.st                      | 54 +++++++++++++++++++
 1 file changed, 54 insertions(+)

diff --git a/src/GToolkit-Utility-System/Context.extension.st b/src/GToolkit-Utility-System/Context.extension.st
index 887dbe5e..8b24c78f 100644
--- a/src/GToolkit-Utility-System/Context.extension.st
+++ b/src/GToolkit-Utility-System/Context.extension.st
@@ -1,5 +1,59 @@
 Extension { #name : #Context }
 
+{ #category : #'*GToolkit-Utility-System' }
+Context >> errorReportOn: stream [
+	"Write a detailed error report on the stack (above me) on a
+	stream.  For both the error file, and emailing a bug report.
+	Suppress any errors while getting printStrings.  Limit the length."
+	| stackDepth aContext maxDetailedStackDepth maxFullStackDepth|
+
+	stream print: Date today; space; print: Time now; cr.
+	stream cr.
+	stream nextPutAll: 'VM: ';
+		nextPutAll: Smalltalk os name asString;
+		nextPutAll: ' - ';
+		nextPutAll: Smalltalk os subtype asString;
+		nextPutAll: ' - ';
+		nextPutAll: Smalltalk os version asString;
+		nextPutAll: ' - ';
+		nextPutAll: Smalltalk vm version asString;
+		cr.
+	stream nextPutAll: 'GT Image: ';
+		nextPutAll: GtImage version versionString;
+		cr.
+	stream nextPutAll: 'Pharo Image: ';
+		nextPutAll:  SystemVersion current version asString;
+		nextPutAll: ' [';
+		nextPutAll: Smalltalk lastUpdateString asString;
+		nextPutAll: ']';
+		cr.
+	stream cr.
+	"Note: The following is an open-coded version of  Context>>stackOfSize: since this method may be called during a  low space condition and we might run out of space for allocating the  full stack."
+	stackDepth := 0.
+	aContext := self.
+	maxDetailedStackDepth := 80.
+	maxFullStackDepth := 400.
+	[ aContext notNil and: [ (stackDepth := stackDepth + 1) < maxDetailedStackDepth ]]
+		whileTrue: [
+			"variable values"
+			aContext printDetails: stream.
+			stream cr.
+			aContext := aContext sender ].
+	stream cr; nextPutAll: '--- The full stack ---'; cr.
+	aContext := self.
+	stackDepth := 0.
+	[ aContext == nil ] whileFalse:	[
+		stackDepth := stackDepth + 1.
+		stackDepth = maxDetailedStackDepth ifTrue: [ stream nextPutAll: ' - - - - - - - - - - - - - - -
+			- - - - - - - - - - - - - - - - - -'; cr ].
+		"just class>>selector"
+		stream print: aContext; cr.
+		stackDepth > maxFullStackDepth ifTrue: [
+			stream nextPutAll: '-- and more not shown --'.
+			^  self ].
+		aContext := aContext sender ]
+]
+
 { #category : #'*GToolkit-Utility-System' }
 Context >> message [
 	"Answer the receiver's selector and arguments as a Message"