The Trunk: ST80-mt.240.mcz

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

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

Name: ST80-mt.240
Author: mt
Time: 24 September 2019, 5:22:22.23186 pm
UUID: 74240c49-e09f-8846-b6d7-8fccdb9dab9e
Ancestors: ST80-mt.239

Complements Tools-mt.893:
- fixes "debug it" for code expressions in workspaces
- adds some warnings for usability
- adds support for proceeding non-ui processes (e.g. "[self halt. 3+4] fork") to keep the UI responsive
- no need for MVCToolBuilder >> #openDebugger: anymore.
- adds detection of recursive errors like Morphic has

=============== Diff against ST80-mt.239 ===============

Item was changed:
  ----- Method: MVCDebugger class>>openInterrupt:onProcess: (in category 'opening') -----
  openInterrupt: aString onProcess: interruptedProcess
  "Open a notifier in response to an interrupt. An interrupt occurs when the user types the interrupt key (cmd-. on Macs, ctrl-c or alt-. on other systems) or when the low-space watcher detects that memory is low."
 
+ | debugger message |
- | debugger |
  <primitive: 19> "Simulation guard"
+
+ Project current world inActiveControllerProcess
+ ifTrue: [^ self notify: 'You cannot interrupt from within the active controller process. Use a helper process instead.\\This interrupt request will be aborted.' withCRs translated].
+
  debugger := self new.
  debugger
  process: interruptedProcess
+ controller: (Project current world activeControllerProcess == interruptedProcess
+ ifTrue: [Project current world activeController])
- controller: (ScheduledControllers inActiveControllerProcess == interruptedProcess
- ifTrue: [ScheduledControllers activeController])
  context: interruptedProcess suspendedContext.
  debugger externalInterrupt: true.
 
+ ((aString includesSubstring: 'Space') and: [aString includesSubstring: 'low'])
+ ifTrue: [
+ "Space is low!! See SmalltalkImage >> #lowSpaceWatcher."
+ message := self lowSpaceChoices.
+ Preferences logDebuggerStackToFile ifTrue: [
+ Smalltalk logError: aString inContext: debugger interruptedContext to: 'LowSpaceDebug.log']]
+ ifFalse: [
+ Preferences logDebuggerStackToFile ifTrue: [
+ Smalltalk logSqueakError: aString inContext: debugger interruptedContext]].
- Preferences logDebuggerStackToFile ifTrue:
- [(aString includesSubstring: 'Space') & (aString includesSubstring: 'low')
- ifTrue: [Smalltalk logError: aString inContext: debugger interruptedContext to: 'LowSpaceDebug.log']
- "logging disabled for 4.3 release, see
- http://lists.squeak.org/pipermail/squeak-dev/2011-December/162503.html"
- "ifFalse: [Smalltalk logSqueakError: aString inContext: debugger interruptedContext]"].
 
+ debugger
+ openNotifierNoSuspendContents: message label: aString;
+ yourself.
+
+ "Since we are in a helper process, #openNoTerminate WILL NOT activate the debugger's controller."
+ Project current world searchForActiveController.
- Preferences eToyFriendly ifTrue: [Project current world stopRunningAll].
- ^debugger
- openNotifierContents: nil label: aString;
- yourself
  !

Item was changed:
  ----- Method: MVCDebugger class>>openOn:context:label:contents:fullView: (in category 'opening') -----
+ openOn: process context: context label: title contents: contentsStringOrNil fullView: full
- openOn: process context: context label: title contents: contentsStringOrNil fullView: bool
  "Open a notifier in response to an error, halt, or notify. A notifier view just shows a short view of the sender stack and provides a menu that lets the user open a full debugger."
 
+ ErrorRecursionGuard critical: [
+
+ | debugger |
+ ErrorRecursion ifTrue: [
+ "self assert: process == Project current uiProcess -- DOCUMENTATION ONLY"
+ self clearErrorRecursion.
+ ^ Project current handleFatalDrawingError: title].
+
+ [ErrorRecursion not & Preferences logDebuggerStackToFile
+ ifTrue: [Smalltalk logSqueakError: title inContext: context]]
+ on: Error
+ do: [:ex | ex return: nil].
+
+ self setErrorRecursion.
+
+ self informExistingDebugger: context label: title.
+
+ debugger := self new
+ process: process
+ controller: (Project current world activeControllerProcess == process
+ ifTrue: [Project current world activeController])
+ context: context.
+
+ full
+ ifTrue: [debugger openFullNoSuspendLabel: title]
+ ifFalse: [debugger openNotifierNoSuspendContents: contentsStringOrNil label: title].
+
+ "Try drawing the debugger tool at least once to avoid freeze."
+ Project current restoreDisplay.
+
+ self clearErrorRecursion].
+
+ process suspend.!
- | controller debugger |
- controller := ScheduledControllers activeControllerProcess == process
- ifTrue: [ScheduledControllers activeController].
- [Preferences logDebuggerStackToFile
- ifTrue: [Smalltalk logSqueakError: title inContext: context]] on: Error do: [:ex | ex return: nil].
- [debugger := self new
- process: process
- controller: controller
- context: context.
- bool
- ifTrue: [debugger openFullNoSuspendLabel: title]
- ifFalse: [debugger openNotifierContents: contentsStringOrNil label: title].
- ] on: Error do: [:ex |
- self primitiveError: 'Original error: ' , title asString , '.
- Debugger error: ' , ([ex description]
- on: Error
- do: ['a ' , ex class printString]) , ':'].
- process suspend!

Item was changed:
  ----- Method: MVCDebugger class>>openOnMethod:forReceiver:inContext: (in category 'opening') -----
  openOnMethod: aCompiledMethod forReceiver: anObject inContext: aContextOrNil
 
+ | guineaPig debugger context inActiveControllerProcess |
+ inActiveControllerProcess := ScheduledControllers inActiveControllerProcess.
+
- | guineaPig debugger debuggerWindow context |
  guineaPig :=
  [aCompiledMethod
  valueWithReceiver: anObject
  arguments: (aContextOrNil ifNil: [ #() ] ifNotNil: [ { aContextOrNil } ]).
+ guineaPig := nil. "Spot the return from aCompiledMethod. See below."
+
+ "If we proceed in the debugger, make sure to keep the system responsive."
+ "ScheduledControllers searchForActiveController"] newProcess.
- guineaPig := nil "spot the return from aCompiledMethod"] newProcess.
  context := guineaPig suspendedContext.
+
  debugger := self new
  process: guineaPig
+ controller: nil "None because the guinea pig does *not* relate to the active controller."
- controller: (ScheduledControllers inActiveControllerProcess ifTrue:
- [ScheduledControllers activeController])
  context: context.
+ debugger initializeFull. "To make #send work. See below."
+
- debuggerWindow := debugger openFullNoSuspendLabel: 'Debug it'.
  "Now step into the expression.  But if it is quick (is implemented as a primtiive, e.g. `0')
  it will return immediately back to the block that is sent newProcess above.  Guard
  against that with the check for home being thisContext."
  [debugger interruptedContext method == aCompiledMethod]
+ whileFalse: [
+ (guineaPig isNil and: [debugger interruptedContext home == thisContext])
+ ifTrue: [^ Project uiManager inform: 'Nothing to debug; expression is optimized.'].
+ debugger send].
+
+ debugger openFullNoSuspendLabel: 'Debug it'.
+ inActiveControllerProcess ifTrue: [Processor terminateActive].!
- whileFalse:
- [(guineaPig isNil
-  and: [debugger interruptedContext home == thisContext]) ifTrue:
- [debuggerWindow controller closeAndUnschedule.
- UIManager default inform: 'Nothing to debug; expression is optimized'.
- ^self].
- debugger send]!

Item was added:
+ ----- Method: MVCDebugger>>abandon: (in category 'initialize') -----
+ abandon: aTopView
+
+ aTopView controller closeAndUnscheduleNoTerminate.!

Item was added:
+ ----- Method: MVCDebugger>>openFullFromNotifier: (in category 'initialize') -----
+ openFullFromNotifier: notifierView
+ "Create, schedule and answer a full debugger with the given label. Do not terminate the current active process."
+
+ | fullView |
+ super openFullFromNotifier: notifierView.
+
+ fullView := ToolBuilder default build: self.
+ fullView label: notifierView label. "Keep the label."
+ fullView controller openNoTerminate.
+
+ notifierView controller closeAndUnscheduleNoTerminate.
+ Processor terminateActive.!

Item was added:
+ ----- Method: MVCDebugger>>openFullNoSuspendLabel: (in category 'initialize') -----
+ openFullNoSuspendLabel: aString
+ "Create, schedule and answer a full debugger with the given label. Do not terminate the current active process."
+
+ | fullView |
+ super openFullNoSuspendLabel: aString.
+
+ fullView := ToolBuilder default build: self.
+ fullView label: aString.
+ fullView controller openNoTerminate.
+
+ ^ fullView!

Item was added:
+ ----- Method: MVCDebugger>>openNotifierNoSuspendContents:label: (in category 'initialize') -----
+ openNotifierNoSuspendContents: msgString label: label
+
+ | builder spec view |
+ super openNotifierNoSuspendContents: msgString label: label.
+
+ builder := ToolBuilder default.
+ spec := self buildNotifierWith: builder label: label message: msgString.
+
+ view := builder build: spec.
+ view controller openNoTerminate.
+
+ ^ view!

Item was changed:
  ----- Method: MVCDebugger>>resumeProcess: (in category 'private') -----
  resumeProcess: aTopView
 
+ | hasActiveController |
  aTopView erase.
+ savedCursor ifNotNil: [Cursor currentCursor: savedCursor].
+
+ hasActiveController := interruptedProcess isTerminated not and: [interruptedController notNil].
+
- savedCursor
- ifNotNil: [Cursor currentCursor: savedCursor].
  interruptedProcess isTerminated ifFalse: [
  ScheduledControllers activeControllerNoTerminate: interruptedController andProcess: interruptedProcess].
+
+ Smalltalk installLowSpaceWatcher. "restart low space handler"
+
- "if old process was terminated, just terminate current one"
  interruptedProcess := nil. "Before delete, so release doesn't terminate it"
  aTopView controller closeAndUnscheduleNoErase.
+
+ hasActiveController
+ ifTrue: [Processor terminateActive]
+ ifFalse: [Project current world searchForActiveController].!
- Smalltalk installLowSpaceWatcher. "restart low space handler"
- Processor terminateActive
- !

Item was changed:
  ----- Method: MVCProject>>interruptName:preemptedProcess: (in category 'scheduling & debugging') -----
  interruptName: labelString preemptedProcess: theInterruptedProcess
  "Create a Notifier on the interrupted process with the given label. Make the Notifier the active controller."
+
+ world inActiveControllerProcess ifTrue: [
+ ^ self inform: 'You cannot interrupt from within the UI process.\Use a helper process instead.' withCRs translated].
 
- theInterruptedProcess suspend.
-
  (world activeController ~~ nil and: [world activeController ~~ world screenController]) ifTrue: [
  theInterruptedProcess == self uiProcess
  ifTrue: [
  "Carefully de-emphasis the current window."
  world activeController view topView deEmphasizeForDebugger]
  ifFalse: [
  world activeController controlTerminate]].
 
+ theInterruptedProcess suspend.
+ self interruptCleanUpFor: theInterruptedProcess.
+
- "This will just scheduleNoTerminate the newly built controller"
  ToolSet
  debugInterruptedProcess: theInterruptedProcess
+ label: labelString.!
- label: labelString.
-
- world searchForActiveController.!

Item was changed:
  ----- Method: StandardSystemController>>closeAndUnscheduleNoErase (in category 'scheduling') -----
  closeAndUnscheduleNoErase
  "Remove the scheduled view from the collection of scheduled views. Set
+ its status to closed but do not erase and do not terminate. For debuggers."
- its status to closed but do not erase."
 
  status := #closed.
  ScheduledControllers unschedule: self.
  view release.!

Item was changed:
  ----- Method: StandardSystemController>>closeAndUnscheduleNoTerminate (in category 'scheduling') -----
  closeAndUnscheduleNoTerminate
+ "Erase the receiver's view and remove it from the collection of scheduled views, but do not terminate the current process. Useful for clean-up scripts."
- "Erase the receiver's view and remove it from the collection of scheduled views, but do not terminate the current process."
 
  status := #closed.
  ScheduledControllers unschedule: self.
  view erase.
  view release.
  !