The Trunk: Tools-mt.1031.mcz

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

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

Name: Tools-mt.1031
Author: mt
Time: 15 March 2021, 11:22:01.998586 am
UUID: a69323cb-b4ee-8e4f-963d-780b2d40e73d
Ancestors: Tools-mt.1030

Complements Kernel-mt.1381

Fixes for debugger invocation during code simulation. See  http://forum.world.st/Please-try-out-Fixes-for-debugger-invocation-during-code-simulation-td5127684.html

=============== Diff against Tools-mt.1030 ===============

Item was changed:
  ----- Method: Debugger class>>openOn:context:label:contents:fullView: (in category 'opening') -----
+ openOn: process context: context label: titleOrNil contents: contentsStringOrNil fullView: bool
- openOn: process context: context label: title contents: contentsStringOrNil fullView: bool
  "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 instead of calling this method directly."
 
+ | ap title |
+ title := titleOrNil ifNil: ['Debugger' translated].
- | ap |
  ap := Processor activeProcess.
 
  "If the active process re-enters this method again, something went wrong with invoking the debugger."
  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. 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 changed:
  ----- Method: ProcessBrowser class>>debugProcess: (in category 'process control') -----
  debugProcess: aProcess
+ (aProcess isActiveProcess ifTrue: [Processor] ifFalse: [aProcess])
+ debugWithTitle: 'Interrupted from the Process Browser' translated
+ full: true.!
- aProcess debugWithTitle: 'Interrupted from the Process Browser'.
- !

Item was changed:
  ----- Method: StandardToolSet class>>debugProcess:context:label:contents:fullView: (in category 'debugging') -----
  debugProcess: aProcess context: aContext label: aString contents: contents fullView: aBool
 
+ (aProcess isTerminated and: [aString isNil or: [aString beginsWith: 'Debug it']]) ifTrue: [
+ ^ Project uiManager inform: 'Nothing to debug. Process has terminated.\Expression optimized.' withCRs translated].
- (aProcess isTerminated and: [aString beginsWith: 'Debug it']) ifTrue: [
- ^ Project uiManager inform: 'Nothing to debug. Process has terminated.\Expression optimized.' withCRs].
 
  ^ Debugger
  openOn: aProcess
  context: aContext
  label: aString
  contents: contents
  fullView: aBool!

Item was changed:
  ----- Method: StandardToolSet class>>handleError: (in category 'debugging - handlers') -----
  handleError: anError
+ "Double dispatch. Let the processor take care of that error, which usually calls back here to #debugProcess:..."
- "Double dispatch. Let the active process take care of that error, which usually calls back here to #debugProcess:..."
 
+ ^ Processor
+ debugContext: anError signalerContext
+ title: anError description
+ full: false
+ contents: nil!
- ^ Processor activeProcess
- debug: anError signalerContext
- title: anError description!

Item was changed:
  ----- Method: StandardToolSet class>>handleWarning: (in category 'debugging - handlers') -----
  handleWarning: aWarning
+ "Double dispatch. Let the processor take care of that warning, which usually calls back here to #debugProcess:..."
- "Double dispatch. Let the active process take care of that warning, which usually calls back here to #debugProcess:..."
 
  | message |
  message := '{1}\\{2}' withCRs asText format: {
  "First, show the actual text of this warning."
  aWarning messageText.
  "Second, append some helpful information that apply to all kinds of warnings."
  ('{1} {2}' asText format: {
  'Select "Proceed" to continue or close this window to cancel the operation.' translated.
  'If you do not want to be interrupted anymore, you can {1} this kind of warning. You can also {2}, which resets such warnings on the next image startup.' translated asText format: {
  "Provide clickable text links so that the user can directly suppress warnings."
  'always suppress' asText
  addAttribute: (PluggableTextAttribute evalBlock: [
  aWarning class suppressWarnings.
  self inform: ('All ''{1}'' warnings will be suppressed.' translated format: {aWarning class name})]).
  'suppress temporarily' asText
  addAttribute: (PluggableTextAttribute evalBlock: [
  aWarning class suppressAndResetOnStartUp.
  self inform: ('All ''{1}'' warnings will be suppressed\and reset on the next image startup.' withCRs translated format: {aWarning class name})])}.
  }) addAttribute: (
  "Show this helpful information in a smaller font."
  TextFontReference toFont: Preferences standardButtonFont)}.
 
+ ^ Processor
+ debugContext: aWarning signalerContext
- ^ Processor activeProcess
- debug: aWarning signalerContext
  title: 'Warning' translated
  full: false
  contents: message!