[squeak-dev] The Trunk: Tools-mt.1184.mcz

commits at source.squeak.org commits at source.squeak.org
Wed Jan 18 16:01:36 UTC 2023


Marcel Taeumel uploaded a new version of Tools to project The Trunk:
http://source.squeak.org/trunk/Tools-mt.1184.mcz

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

Name: Tools-mt.1184
Author: mt
Time: 18 January 2023, 5:01:34.930866 pm
UUID: a3984e4c-e30d-9548-830e-ed0ff36a1809
Ancestors: Tools-mt.1183

*** Debugger Refactoring - Step 2 of 2 ***

Clean-up Debugger class itself. Use the new hooks into Project via Debugger >> #openWithLabel:contents:fullView:.

The editor for syntax errors can now work without an instance of Debugger.

Complements System-mt.1382.

=============== Diff against Tools-mt.1183 ===============

Item was changed:
  CodeHolder subclass: #Debugger
+ 	instanceVariableNames: 'interruptedProcess contextStack contextStackIndex contextStackList receiverInspector receiverInspectorState contextVariablesInspector contextVariablesInspectorState proceedValue selectingPC labelString message untilExpression terminateProcessSelector'
+ 	classVariableNames: 'CloseMeansAbandon ContextStackKeystrokes ErrorReportServer FullStackSize InterruptUIProcessIfBlockedOnErrorInBackgroundProcess NotifierStackSize ShowAbandonButton ShowTerminateButton StackSizeLimit WantsAnnotationPane'
- 	instanceVariableNames: 'interruptedProcess contextStack contextStackIndex contextStackList receiverInspector receiverInspectorState contextVariablesInspector contextVariablesInspectorState externalInterrupt proceedValue selectingPC savedCursor isolationHead failedProject labelString message untilExpression terminateProcessSelector'
- 	classVariableNames: 'CloseMeansAbandon ContextStackKeystrokes ErrorReportServer FullStackSize InterruptUIProcessIfBlockedOnErrorInBackgroundProcess NotifierStackSize SavedExtent ShowAbandonButton ShowTerminateButton StackSizeLimit WantsAnnotationPane'
  	poolDictionaries: ''
  	category: 'Tools-Debugger'!
  
+ !Debugger commentStamp: 'mt 1/18/2023 16:40' prior: 0!
- !Debugger commentStamp: 'mt 12/17/2019 12:19' prior: 0!
  I represent the machine state at the time of an interrupted process. I also represent a query path into the state of the process. The debugger is typically viewed through a window that views the stack of suspended contexts, the code for, and execution point in, the currently selected message, and inspectors on both the receiver of the currently selected message, and the variables in the current context.
  
  Special note on recursive errors:
  Some errors affect Squeak's ability to present a debugger.  This is normally an unrecoverable situation.  However, if such an error occurs in an isolation layer, Squeak will attempt to exit from the isolation layer and then present a debugger.  Here is the chain of events in such a recovery.
  
  	* A recursive error is detected.
  	* The current project is queried for an isolationHead
  	* Changes in the isolationHead are revoked
  	* The parent project of isolated project is returned to
  	* The debugger is opened there and execution resumes.
  
+ If the user closes that debugger, execution continues in the outer project and layer.  If, after repairing some damage, the user proceeds from the debugger, then the isolationHead is re-invoked, the failed project is re-entered, and execution resumes in that world. !
- If the user closes that debugger, execution continues in the outer project and layer.  If, after repairing some damage, the user proceeds from the debugger, then the isolationHead is re-invoked, the failed project is re-entered, and execution resumes in that world. 
- 
- ---
- 
- In September 2019, we added MorphicDebugger and MVCDebugger to untangle framework-specific features in our debugger infrastructure. However, this is just an intermediate step. The overall goal would be to remove those two subclasses again while preserving their functionality. Mostly, MVC and Morphic differ in their GUI-process management. This means that "proceed" and "close" work differently depending on the process that is being debugged. --- One idea is to attach that framework-specific information to the process objects. See Process >> #environmentAt: and #environmentAt:put:. Also see ToolSet's #handle* and #debug* methods.!

Item was removed:
- ----- Method: Debugger class>>informExistingDebugger:label: (in category 'instance creation') -----
- informExistingDebugger: aContext label: aString
- 	"Walking the context chain, we try to find out if we're in a debugger stepping situation.
- 	 If we find the relevant contexts, we must rearrange them so they look just like they would
- 	 if the methods were executed outside of the debugger.
- 	 hmm 8/3/2001 13:05"
- 	| ctx quickStepMethod oldSender baseContext |
- 	ctx := thisContext.
- 	quickStepMethod := Context
- 							compiledMethodAt: #quickSend:to:with:lookupIn:
- 							ifAbsent: [Context compiledMethodAt: #quickSend:to:with:super:].
- 	[ctx sender == nil or: [ctx sender method == quickStepMethod]] whileFalse:
- 		[ctx := ctx sender].
- 	ctx sender ifNil: [^self].
- 	baseContext := ctx.
- 	"baseContext is now the context created by the #quickSend... method."
- 	oldSender := ctx := ctx sender home sender.
- 	"oldSender is the context which originally sent the #quickSend... method"
- 	[ctx == nil or: [(ctx objectClass: ctx receiver) includesBehavior: self]] whileFalse:
- 		[ctx := ctx sender].
- 	ctx ifNil: [^self].
- 	"ctx is the context of the Debugger method #doStep"
- 	ctx receiver
- 		labelString: aString;
- 		proceedValue: aContext receiver.
- 	baseContext swapSender: baseContext sender sender sender.	"remove intervening contexts"
- 	thisContext swapSender: oldSender.	"make myself return to debugger"
- 	^ aContext!

Item was changed:
  ----- Method: Debugger class>>initialize (in category 'class initialization') -----
  initialize
  	ContextStackKeystrokes := Dictionary new
  		at: $e put: #send;
  		at: $t put: #doStep;
  		at: $T put: #stepIntoBlock;
  		at: $p put: #proceed;
  		at: $r put: #restart;
  		at: $f put: #fullStack;
  		at: $w put: #where;
  		yourself.
- 	SavedExtent := self new initialExtent
  
  	"Debugger initialize"!

Item was added:
+ ----- Method: Debugger class>>onContext: (in category 'instance creation') -----
+ onContext: aContext
+ 
+ 	^ self new
+ 		context: aContext;
+ 		yourself!

Item was added:
+ ----- Method: Debugger class>>onProcess:context: (in category 'instance creation') -----
+ onProcess: aProcess context: aContext
+ 
+ 	^ self new
+ 		process: aProcess context: aContext;
+ 		yourself!

Item was changed:
  ----- Method: Debugger class>>openOn:context:label:contents:fullView: (in category 'opening') -----
  openOn: process context: context label: titleOrNil contents: contentsStringOrNil fullView: bool
+ 	"Open a notifier or a full debugger window for the given process at the given context. Decorates that invocation with (1) recursive-error detection and (2) error logging, which are both independent from the active GUI framework, that is, MVC or Morphic.
- 	"Kind of private. Open a notifier or a full debugger in response to an error, halt, or notify. Opens a project-specific debugger. Decorates that invocation with (1) recursive-error detection and (2) error logging, which are both independent from the active GUI framework, that is, MVC or Morphic.
  	
+ 	Note that clients should debug processes through Process >> #debug or ToolSet instead of calling this method directly."
- 	Note that clients should debug processes through Process >> #debug instead of calling this method directly."
  
+ 	| activeProcess title |
+ 	activeProcess := Processor activeProcess.
- 	| ap title |
  	title := titleOrNil ifNil: ['Debugger' translated].
- 	ap := Processor activeProcess.
  	
  	"If the active process re-enters this method again, something went wrong with invoking the debugger."
+ 	activeProcess hasRecursiveError ifTrue: [
+ 		activeProcess clearErrorRecursionFlag.
- 	ap hasRecursiveError ifTrue: [
- 		ap clearErrorRecursionFlag.
  		^ ToolSet handleRecursiveError: title].
  	
  	"Explicitely handle logging exceptions. No need to bother the recursion mechanism here."
  	[Preferences logDebuggerStackToFile
  		ifTrue: [Smalltalk logSqueakError: title inContext: context]
  	] on: Error do: [:ex |
  		Preferences disable: #logDebuggerStackToFile.
  		ToolSet debugException: ex].
  
+ 	"If project-specific debuggers mess up, we have to flag that recursion here. See above."
+ 	[activeProcess setErrorRecursionFlag.
+ 		^ (self onProcess: process context: context)
+ 			openWithLabel: title contents: contentsStringOrNil fullView: bool;
+ 			yourself
+ 	] ensure: [activeProcess clearErrorRecursionFlag].!
- 	"If project-specific debuggers mess up, we have to flag that recursion here. Se above."
- 	[ap setErrorRecursionFlag.
- 
- 		self informExistingDebugger: context label: title.
- 
- 		^ Project current debuggerClass
- 			openOn: process context: context label: title contents: contentsStringOrNil fullView: bool
- 
- 	] ensure: [ap clearErrorRecursionFlag].!

Item was removed:
- ----- Method: Debugger>>buildFullWith: (in category 'toolbuilder') -----
- buildFullWith: builder
- 	| windowSpec listSpec textSpec |
- 	windowSpec := builder pluggableWindowSpec new
- 		model: self;
- 		label: 'Debugger';
- 		children: OrderedCollection new.
- 
- 	listSpec := builder pluggableListSpec new.
- 	listSpec 
- 		model: self;
- 		list: #contextStackList; 
- 		getIndex: #contextStackIndex; 
- 		setIndex: #toggleContextStackIndex:; 
- 		menu: #contextStackMenu:shifted:; 
- 		icon: #messageIconAt:;
- 		helpItem: #messageHelpAt:;
- 		keyPress: #contextStackKey:from:;
- 		frame: (0 at 0 corner: 1 at 0.22).
- 	windowSpec children add: listSpec.
- 
- 
- 	textSpec := self buildCodePaneWith: builder.
- 	textSpec frame: (0 at 0.22corner: 1 at 0.8).
- 	windowSpec children add: textSpec.
- 
- 	listSpec := self receiverInspector buildFieldListWith: builder.
- 	listSpec 
- 		frame: (0 at 0.8 corner: 0.2 at 1);
- 		help: 'Receiver''s\Instance\Variables' withCRs.
- 	windowSpec children add: listSpec.
- 
- 	textSpec := self receiverInspector buildValuePaneWith: builder.
- 	textSpec 
- 		help: '<- Select receiver''s field' translated;
- 		frame: (0.2 at 0.8 corner: 0.5 at 1).
- 	windowSpec children add: textSpec.
- 
- 	listSpec := self contextVariablesInspector buildFieldListWith: builder.
- 	listSpec 
- 		frame: (0.5 at 0.8 corner: 0.7 at 1);
- 		help: 'Other\Context\Bindings' withCRs.
- 	windowSpec children add: listSpec.
- 
- 	textSpec := self contextVariablesInspector buildValuePaneWith: builder.
- 	textSpec 
- 		help: '<- Select context''s field' translated;
- 		frame: (0.7 at 0.8 corner: 1 at 1).
- 	windowSpec children add: textSpec.
- 
- 	^builder build: windowSpec!

Item was added:
+ ----- Method: Debugger>>buildFullWith:label: (in category 'toolbuilder') -----
+ buildFullWith: builder label: label
+ 	| windowSpec listSpec textSpec |
+ 	windowSpec := builder pluggableWindowSpec new
+ 		model: self;
+ 		label: label;
+ 		children: OrderedCollection new.
+ 
+ 	listSpec := builder pluggableListSpec new.
+ 	listSpec 
+ 		model: self;
+ 		list: #contextStackList; 
+ 		getIndex: #contextStackIndex; 
+ 		setIndex: #toggleContextStackIndex:; 
+ 		menu: #contextStackMenu:shifted:; 
+ 		icon: #messageIconAt:;
+ 		helpItem: #messageHelpAt:;
+ 		keyPress: #contextStackKey:from:;
+ 		frame: (0 at 0 corner: 1 at 0.22).
+ 	windowSpec children add: listSpec.
+ 
+ 
+ 	textSpec := self buildCodePaneWith: builder.
+ 	textSpec frame: (0 at 0.22corner: 1 at 0.8).
+ 	windowSpec children add: textSpec.
+ 
+ 	listSpec := self receiverInspector buildFieldListWith: builder.
+ 	listSpec 
+ 		frame: (0 at 0.8 corner: 0.2 at 1);
+ 		help: 'Receiver''s\Instance\Variables' withCRs.
+ 	windowSpec children add: listSpec.
+ 
+ 	textSpec := self receiverInspector buildValuePaneWith: builder.
+ 	textSpec 
+ 		help: '<- Select receiver''s field' translated;
+ 		frame: (0.2 at 0.8 corner: 0.5 at 1).
+ 	windowSpec children add: textSpec.
+ 
+ 	listSpec := self contextVariablesInspector buildFieldListWith: builder.
+ 	listSpec 
+ 		frame: (0.5 at 0.8 corner: 0.7 at 1);
+ 		help: 'Other\Context\Bindings' withCRs.
+ 	windowSpec children add: listSpec.
+ 
+ 	textSpec := self contextVariablesInspector buildValuePaneWith: builder.
+ 	textSpec 
+ 		help: '<- Select context''s field' translated;
+ 		frame: (0.7 at 0.8 corner: 1 at 1).
+ 	windowSpec children add: textSpec.
+ 
+ 	^builder build: windowSpec!

Item was changed:
  ----- Method: Debugger>>buildWith: (in category 'toolbuilder') -----
  buildWith: aBuilder
+ 	^self buildFullWith: aBuilder label: 'Debugger'!
- 	^self buildFullWith: aBuilder!

Item was added:
+ ----- Method: Debugger>>buildWithLabel:contents:fullView: (in category 'toolbuilder') -----
+ buildWithLabel: title contents: contentsStringOrNil fullView: full 
+ 
+ 	| builder |
+ 	builder := ToolBuilder default.
+ 	^ full
+ 		ifTrue: [
+ 			self
+ 				initializeFull;
+ 				buildFullWith: builder label: title]
+ 		ifFalse: [
+ 			self
+ 				expandNotifierStack;
+ 				buildNotifierWith: builder label: title message: contentsStringOrNil]!

Item was changed:
+ ----- Method: Debugger>>close (in category 'initialize-release') -----
- ----- Method: Debugger>>close (in category 'initialize') -----
  close
  	"Close and delete this debugger. Try to trigger the close request through the UI first, do manually of not in the UI."
  
  	self flag: #refactor. "mt: Maybe move this up to model?"
  	self topView
  		ifNotNil: [self changed: #close]
  		ifNil: [
  			self okToClose ifTrue: [
  				self windowIsClosing; release]].!

Item was changed:
+ ----- Method: Debugger>>context: (in category 'initialize-release') -----
- ----- Method: Debugger>>context: (in category 'initialize') -----
  context: aContext
  
  	self
  		process: Processor activeProcess
  		context: aContext.!

Item was changed:
+ ----- Method: Debugger>>customButtonSpecs (in category 'initialize-release') -----
- ----- Method: Debugger>>customButtonSpecs (in category 'initialize') -----
  customButtonSpecs
  	"Answer an array of elements of the form wording, selector, help-message, that characterize the custom button row of a debugger."
  
  	| list |
  	list := #(('Proceed'	proceed				'Close the debugger and proceed.'	interruptedProcessShouldResume)
  		('Restart'		restart				'Reset this context to its start.')
  		('Into'			stepInto				'step Into message sends'	interruptedProcessIsReady)
  		('Over'			stepOver				'step Over message sends'	interruptedProcessIsReady)
  		('Through'		stepThrough		'step into a block'			interruptedProcessIsReady)
  		('Full Stack'		showFullStack			'show full stack')
  		('Where'		showWhere				'select current pc range')
  		('Tally It'			tally				'evaluate current selection and measure the time')).
  	(Preferences restartAlsoProceeds and: [self interruptedProcessShouldResume]) ifTrue:
  		[list := list collect: [:each |
  			each second == #restart
  				ifTrue: [each copy
  						at: 1 put: 'Proceed Here';
  						at: 3 put: 'Proceed from the beginning of this context.';
  						yourself]
  				ifFalse: [each second == #proceed
  					ifTrue: [each copy
  							at: 1 put: 'Proceed Top';
  							at: 3 put: 'Proceed from the current top context.';
  							yourself]
  					ifFalse: [each]]]].
  	^ list!

Item was removed:
- ----- Method: Debugger>>doNothing: (in category 'accessing') -----
- doNothing: newText
- 	"Notifier window can't accept text"!

Item was removed:
- ----- Method: Debugger>>externalInterrupt: (in category 'private') -----
- externalInterrupt: aBoolean
- 
- 	externalInterrupt := aBoolean !

Item was changed:
+ ----- Method: Debugger>>initialExtent (in category 'initialize-release') -----
- ----- Method: Debugger>>initialExtent (in category 'initialize') -----
  initialExtent
  	"Initial extent for the full debugger. For the notifier's extent see #initialExtentForNotifier."
  	
+ 	^ 600 at 700!
- 	^ SavedExtent ifNil: [ 600 at 700]!

Item was changed:
+ ----- Method: Debugger>>initialExtentForNotifier (in category 'initialize-release') -----
- ----- Method: Debugger>>initialExtentForNotifier (in category 'initialize') -----
  initialExtentForNotifier
  
  	^ 450 at 200!

Item was changed:
+ ----- Method: Debugger>>initialize (in category 'initialize-release') -----
- ----- Method: Debugger>>initialize (in category 'initialize') -----
  initialize
  
  	super initialize.
  
  	Smalltalk at: #MessageTally ifPresentAndInMemory: [ :tally |
  		tally terminateTimerProcess].
  
- 	externalInterrupt := false.
  	selectingPC := true.
- 	
  	contextStackIndex := 0.
  	
  	"The default termination procedure is aggressive to ignore currently running, and thus erroneous, ensure-blocks in the debugged process. The preference can change that."
  	terminateProcessSelector := self class closeMeansAbandon
  		ifTrue: [#terminateAggressively]
  		ifFalse:[#terminate].!

Item was changed:
+ ----- Method: Debugger>>initializeFull (in category 'initialize-release') -----
- ----- Method: Debugger>>initializeFull (in category 'initialize') -----
  initializeFull
  	"Expand the stack for the full debugger. Create inspectors."
  	
  	| oldIndex |
  	oldIndex := contextStackIndex.
  	contextStackIndex := 0.
  	
  	self expandStack.
  
  	receiverInspector := Inspector on: nil.
  	contextVariablesInspector := ContextVariablesInspector on: nil.
  	
  	self toggleContextStackIndex: oldIndex.!

Item was changed:
+ ----- Method: Debugger>>openFullFromNotifier: (in category 'initialize-release') -----
- ----- Method: Debugger>>openFullFromNotifier: (in category 'initialize') -----
  openFullFromNotifier: topView
+ 	"Create a full debugger to replace the given view."
- 	"Create a full debugger with the given label. Subclasses should complete this procedure."
  
  	self initializeFull.
  	
  	topView model: nil.  "so close won't release me."
+ 	self breakDependents.
+ 	
+ 	^ ToolBuilder default
+ 		close: topView;
+ 		open: self label: topView label "Keep the label."!
- 	self breakDependents.!

Item was removed:
- ----- Method: Debugger>>openFullNoSuspendLabel: (in category 'initialize') -----
- openFullNoSuspendLabel: aString
- 	"Create, schedule and answer a full debugger with the given label. Subclasses should complete this procedure."
- 
- 	self initializeFull.!

Item was changed:
+ ----- Method: Debugger>>openNotifierNoSuspendContents:label: (in category 'initialize-release') -----
- ----- Method: Debugger>>openNotifierNoSuspendContents:label: (in category 'initialize') -----
  openNotifierNoSuspendContents: msgString label: label
  	"Create, schedule and answer a notifier view with the given label and message. A notifier view shows just the message or the first several lines of the stack, with a menu that allows the user to open a full debugger if so desired."
- 	"NOTE: When this method returns, a new process has been scheduled to run the windows, and thus this notifier, but the previous active process has not been suspended.  The sender will do this."
  
+ 	self deprecated: 'ct: Use #openWithLabel:contents:fullView: instead'.
+ 	^ self openWithLabel: label contents: msgString fullView: false!
- 	savedCursor := Cursor currentCursor.
- 	Cursor currentCursor: Cursor normal.
- 	
- 	self expandNotifierStack.!

Item was added:
+ ----- Method: Debugger>>openWithLabel:contents:fullView: (in category 'initialize-release') -----
+ openWithLabel: labelString contents: contentsStringOrNil fullView: full
+ 	"Open the receiver in a window. Note that we cannot rely on the default #buildWith: callback because debuggers can be compact (i.e. the notifier) or full, which we must decide here."
+ 	
+ 	| window |
+ 	window := self
+ 		buildWithLabel: labelString
+ 		contents: contentsStringOrNil
+ 		fullView: full.
+ 	Project current
+ 		addDeferredUIMessage: [
+ 			"Make sure to refresh GUI elements that depend on certain process state."
+ 			self changed: #interruptedProcessShouldResume.
+ 			self changed: #interruptedProcessIsReady];
+ 		debugProcess: interruptedProcess "may not yet be suspended"
+ 		inWindow: window.
+ 	
+ 	"Answer the receiver, but only if active process is not the process-to-debug. So in tests, use a helper process if you want to access the debugger itself."
+ 	"self assert: [Processor activeProcess ~~ interruptedProcess]. -- works only if not simulated"!

Item was changed:
+ ----- Method: Debugger>>preDebugButtonQuads (in category 'initialize-release') -----
- ----- Method: Debugger>>preDebugButtonQuads (in category 'initialize') -----
  preDebugButtonQuads
  
  	^Preferences eToyFriendly
  		ifTrue: [
  	{
  	{'Send error report' translated.	#sendReport. 	#blue. 	'send a report of the encountered problem to the Squeak developers' translated}.
  	{'Abandon' translated.	#abandon. 	#black.	'abandon this execution by closing this window' translated}.
  	{'Debug'	 translated.		#debug. 	#red. 	'bring up a debugger' translated}}]
  		ifFalse: [
  	{
  	{'Proceed' translated.	#proceed. 	#blue. 	'continue execution' translated. #interruptedProcessShouldResume}.
  	self class showTerminateButton ifTrue: [
  		{'Terminate' translated.	#terminateProcess. 	#black.	'terminate this execution and close this window' translated}].
  	self class showAbandonButton ifTrue: [
  		{'Abandon' translated.	#abandon. 	#black.	'terminate this execution aggressively and close this window' translated}].
  	{'Debug'	 translated.		#debug.		#red. 	'bring up a debugger' translated}}
  		reject: [:quad | quad isNil] ]
  !

Item was changed:
  ----- Method: Debugger>>proceed (in category 'context stack menu') -----
  proceed
  	"Proceed from the interrupted state of the currently selected context. The argument is the topView of the receiver. That view is closed. The active process usually suspends (or terminates) after this call."
  
  	| processToResume canResume |
  
  	Smalltalk okayToProceedEvenIfSpaceIsLow ifFalse: [^ self].
  	
  	self okToChange ifFalse: [^ self].
  	self checkContextSelection.
  	
  	processToResume := interruptedProcess.
  	canResume := self interruptedProcessShouldResume.
  	
  	interruptedProcess := nil. "Before delete, so release doesn't terminate it"
  	self close.
  	
- 	savedCursor ifNotNil: [Cursor currentCursor: savedCursor].
- 	Project current restoreDisplay.
- 	
  	Smalltalk installLowSpaceWatcher. "restart low space handler"
  	
  	canResume
  		ifTrue: [self resumeProcess: processToResume]
+ 		ifFalse: [self notify: 'This process should not resume.\Debugger will close now.' translated withCRs].!
- 		ifFalse: [self notify: 'This process should not resume.\Debugger will close now.' withCRs].!

Item was changed:
+ ----- Method: Debugger>>process:context: (in category 'initialize-release') -----
- ----- Method: Debugger>>process:context: (in category 'initialize') -----
  process: aProcess context: aContext
  
  	interruptedProcess := aProcess.
  
  	self newStack: (aContext stackOfSize: 1).
  	contextStackIndex := 1.!

Item was changed:
+ ----- Method: Debugger>>resumeProcess: (in category 'initialize-release') -----
- ----- Method: Debugger>>resumeProcess: (in category 'private') -----
  resumeProcess: aProcess
+ 	"Let the current project take care of resuming aProcess. The receiver's window (or topView) was probably closed already. Complements #openWithLabel:contents:fullView:. See #proceed."
+ 
+ 	Project current resumeProcessSafely: aProcess.!
- 	"Subclusses may override this to avoid having duplicate UI processes."
- 	
- 	aProcess resume.!

Item was changed:
+ ----- Method: Debugger>>windowIsClosing (in category 'initialize-release') -----
- ----- Method: Debugger>>windowIsClosing (in category 'initialize') -----
  windowIsClosing
  	"My window is being closed; clean up. Restart the low space watcher."
  
  	contextStack := nil.
  	receiverInspector := nil.
  	contextVariablesInspector := nil.
  	
  	interruptedProcess == nil ifTrue: [^ self].
  	self flag: #discuss. "mt: Maybe #fork the termination of the process.
  		See
  			- http://lists.squeakfoundation.org/pipermail/squeak-dev/2022-May/220675.html
  			- http://lists.squeakfoundation.org/pipermail/squeak-dev/2022-June/221044.html"
  	interruptedProcess perform: terminateProcessSelector.
  	interruptedProcess := nil.
  	
  	Smalltalk installLowSpaceWatcher.  "restart low space handler"!

Item was removed:
- ----- Method: StandardToolSet class>>debugSyntaxError: (in category 'debugging') -----
- debugSyntaxError: aSyntaxErrorNotification
- 	
- 	^ SyntaxError open: aSyntaxErrorNotification!

Item was changed:
  ----- Method: StandardToolSet class>>handleSyntaxError: (in category 'debugging - handlers') -----
  handleSyntaxError: aSyntaxErrorNotification
- 	"Double dispatch. Let the current project manage processes, which usually calls back into #debugSyntaxError:."
  	
+ 	^ SyntaxError open: aSyntaxErrorNotification!
- 	^ Project current syntaxError: aSyntaxErrorNotification!

Item was changed:
  StringHolder subclass: #SyntaxError
+ 	instanceVariableNames: 'class selector notification compilerProcess'
- 	instanceVariableNames: 'class selector debugger notification'
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'Tools-Debugger'!
  
  !SyntaxError commentStamp: '<historical>' prior: 0!
  I represent syntax error report for syntax errors encountered when filing in class descriptions from a non-interactive source such as an external file. As a StringHolder, the string to be viewed is the method code or expression containing the error.
  
  The user may fix the error and accept the method to continue the fileIn.
  !

Item was changed:
  ----- Method: SyntaxError class>>open: (in category 'instance creation') -----
  open: aSyntaxErrorNotification
+ 
+ 	^ self new
+ 		setNotification: aSyntaxErrorNotification;
+ 		open!
- 	
- 	^ ToolBuilder default openDebugger: (self new setNotification: aSyntaxErrorNotification; yourself)!

Item was changed:
  ----- Method: SyntaxError>>buildWith: (in category 'toolbuilder') -----
  buildWith: builder
  
+ 	| windowSpec listSpec textSpec listHeight |
- 	| windowSpec listSpec textSpec |
  	windowSpec := builder pluggableWindowSpec new
  		model: self;
  		label: 'Syntax Error';
  		children: OrderedCollection new.
  
+ 	listHeight := builder listHeight.
  	listSpec := builder pluggableListSpec new.
  	listSpec 
  		model: self;
  		list: #list; 
  		getIndex: #listIndex; 
  		setIndex: nil; 
  		menu: #listMenu:;
+ 		frame: (LayoutFrame fractions: (0 at 0 corner: 1 at 0) offsets: (0 at 0 corner: 0 at listHeight)). 
- 		frame: (0 at 0 corner: 1 at 0.15).
  	windowSpec children add: listSpec.
  
  	textSpec := builder pluggableCodePaneSpec new.
  	textSpec 
  		model: self;
  		getText: #contents; 
  		setText: #contents:notifying:; 
  		selection: #contentsSelection; 
  		menu: #codePaneMenu:shifted:;
+ 		frame: (LayoutFrame fractions: (0 at 0 corner: 1 at 1) offsets: (0 at listHeight corner: 0 at 0)).
- 		frame: (0 at 0.15 corner: 1 at 1).
  	windowSpec children add: textSpec.
  
  	^ builder build: windowSpec!

Item was changed:
  ----- Method: SyntaxError>>debug (in category 'menu') -----
  debug
  	"Show the stack of the process leading to this syntax editor, typically showing the stack of the compiler as called from fileIn."
  
+ 	ToolSet
+ 		debugProcess: compilerProcess
+ 		context: notification signalerContext
+ 		label: 'Stack of the Syntax Error' translated
+ 		contents: nil
+ 		fullView: true.
+ 	
+ 	"Receiver must give up control over that process now."
+ 	compilerProcess := nil.
+ 	self changed: #close.!
- 	debugger openFullNoSuspendLabel: 'Stack of the Syntax Error'.
- 	Smalltalk isMorphic ifFalse: [Processor terminateActive].
- !

Item was removed:
- ----- Method: SyntaxError>>debugger (in category 'accessing') -----
- debugger
- 
- 	^ debugger!

Item was added:
+ ----- Method: SyntaxError>>open (in category 'initialize-release') -----
+ open
+ 	
+ 	Project current
+ 		debugProcess: compilerProcess
+ 		inWindow: self.!

Item was changed:
+ ----- Method: SyntaxError>>proceed (in category 'initialize-release') -----
- ----- Method: SyntaxError>>proceed (in category 'menu') -----
  proceed
+ 	"The user has has edited and presumably fixed the syntax error and the filein can now proceed. The active process usually suspends (or terminates) after this call. Implementation similar to Debugger >> #proceed."
- 	"The user has has edited and presumably fixed the syntax error and the filein can now proceed. The active process usually suspends (or terminates) after this call."
  
+ 	| processToResume canResume |
+ 	processToResume := compilerProcess.
+ 	canResume := compilerProcess shouldResumeFromDebugger.
+ 	
+ 	compilerProcess := nil. "Before delete, so release doesn't terminate it"
+ 	self changed: #close.
+ 	
+ 	canResume
+ 		ifTrue: [Project current resumeProcessSafely: processToResume]
+ 		ifFalse: [self notify: 'This complier process should not resume.\Editor will close now.' translated withCRs].!
- 	[debugger proceed]
- 		ensure: [self changed: #close].!

Item was changed:
  ----- Method: SyntaxError>>release (in category 'initialize-release') -----
  release
+ 
+ 	compilerProcess ifNotNil: [
+ 		compilerProcess terminate.
+ 		compilerProcess := nil].
+ 	
+ 	super release.!
- 	debugger ifNotNil:
- 		[debugger interruptedProcess ifNotNil:
- 			[:p |	p isTerminated ifFalse:
- 				[p terminate]]].!

Item was changed:
+ ----- Method: SyntaxError>>setNotification: (in category 'initialize-release') -----
- ----- Method: SyntaxError>>setNotification: (in category 'accessing') -----
  setNotification: aSyntaxErrorNotification
  
  	| types printables badChar code |
  	notification := aSyntaxErrorNotification.
  	class := aSyntaxErrorNotification errorClass.
  	
+ 	compilerProcess := Processor activeProcess.
- 	debugger := Project current debuggerClass new.
- 	debugger context: aSyntaxErrorNotification signalerContext.
  	
  	code := aSyntaxErrorNotification errorCode.
  	selector := class newParser parseSelector: code.
  	types := Scanner classPool at: #TypeTable.	"dictionary"
  	printables := '!!@#$%&*-_=+<>{}?/\,·£¢§¶ªº–—“‘”’…Úæگ׿«»`~`' asSet.
  	badChar := code detect: [:aChar | (types at: aChar asciiValue ifAbsent: [#xLetter]) == #xBinary and: [
  			(printables includes: aChar) not]] ifNone: [nil].
  	contents := badChar 
  		ifNil: [code]
  		ifNotNil: ['<<<This string contains a character (ascii value ', 
  			badChar asciiValue printString,
  			') that is not normally used in code>>> ', code].
  		
  	self changed: #contentsSelection.!



More information about the Squeak-dev mailing list