#FEATURE by cg
authorClaus Gittinger <cg@exept.de>
Tue, 16 Jan 2018 17:19:57 +0100
changeset 17876 753d9034bc87
parent 17875 c345e9001548
child 17877 b1761a097d6e
#FEATURE by cg class: Tools::NewSystemBrowser new debugging feature: breakpoint when returning added: #debugMenuBreakPointWhenReturning changed: #debugMenuBreakPointIf class: Tools::NewSystemBrowser class changed: #flyByHelpSpec #methodDebugMenu
Tools__NewSystemBrowser.st
--- a/Tools__NewSystemBrowser.st	Tue Jan 02 21:49:13 2018 +0100
+++ b/Tools__NewSystemBrowser.st	Tue Jan 16 17:19:57 2018 +0100
@@ -1,3 +1,5 @@
+"{ Encoding: utf8 }"
+
 "
  COPYRIGHT (c) 2000 by eXept Software AG
               All Rights Reserved
@@ -27,7 +29,8 @@
 		LastCategoryRenameOld LastCategoryRenameNew LastProjectMoves
 		LastNameSpaceMove LastMethodMoveOrCopyTargetClass
 		LastClassFilterBlockString LastMethodFilterBlockString
-		LastBreakPointConditionString LastIndividualChecks
+		LastBreakPointConditionString
+		LastBreakPointOnReturnConditionString LastIndividualChecks
 		LastAcceptPackage LastVariableRenames LastVisitorClassName
 		LastTemporaryVariableName FindHistory SynchronousUpdate
 		DoubleClickIsOpenBrowser ShowMethodTemplateWhenProtocolIsSelected
@@ -348,7 +351,7 @@
 'Show only methods with matching selectors / which contain the text '
 
 #nameFilterType
-'Switch between selector- (S) and text matching (T)'
+'Switch between selector- (S) and text matching (T).\The negative versions will only show methods which do not contain the pattern.'
 
 #hideNameFilter
 'Hide the filter. Show again via the "View"-Menu'
@@ -9905,6 +9908,11 @@
             itemValue: debugMenuBreakPointIf
           )
          (MenuItem
+            enabled: hasMethodSelectedHolder
+            label: 'Breakpoint When Returning...'
+            itemValue: debugMenuBreakPointWhenReturning
+          )
+         (MenuItem
             label: '-'
           )
          (MenuItem
@@ -40264,6 +40272,9 @@
 [:context :method |
     counter := counter + 1.
 
+     "/ Conditional BREAKPOINT on ENTRY to method
+     "/ =========================================
+     "/
      "/ Define condition for breakpoint below:
      "/     Useful queries are:
      "/         - Processor activeProcess       the active process
@@ -40278,8 +40289,8 @@
      "/
      "/     Other Useful stuff:
      "/         - counter                       invocation counter
-
-     "/ examples:
+     "/
+     "/ examples (uncomment/edit to fit your taste):
 
      "/ stop if the receiver is a NewSystemBrowser
      "/     (context receiver isMemberOf:NewSystemBrowser)
@@ -40435,6 +40446,99 @@
     "Modified (comment): / 13-02-2017 / 20:33:26 / cg"
 !
 
+debugMenuBreakPointWhenReturning
+    "set a breakpoint on the current method(s), 
+     which trigger(s) if the method is about to return."
+
+    |conditionBlockString conditionBlock dialog textHolder template|
+
+    template :=
+'"/ General breakpoint
+"/
+"/ the following block should evaluate to true, if the breakPoint is to fire.
+"/ Please change as required.
+"/ Beginner warning: Smalltalk know-how is useful here.
+
+|counter|
+counter := 0.
+
+[:returnValue :context :method |
+    counter := counter + 1.
+
+     "/ Conditional BREAKPOINT on RETURN from method
+     "/ ============================================
+     "/
+     "/ Define condition for the breakpoint below:
+     "/     Useful queries are:
+     "/         - Processor activeProcess       the active process
+     "/
+     "/     Useful queries to the context are:
+     "/         - receiver                      the receiver
+     "/         - argAt:N                       the N''th argument
+     "/         - receiver instVarNamed:''nm''  an instance variable in the receiver
+     "/         - sender                        the sender context
+     "/         - sender selector               the sender context''s selector
+     "/         - sender receiver               the sender context''s receiver
+     "/
+     "/     Other Useful stuff:
+     "/         - counter                       invocation counter
+     "/
+     "/ examples (uncomment/edit to fit your taste):
+
+     "/ stop if the return value has a particular value:
+     "/     (returnValue == #foo)
+
+     "/ stop if the return value is in a range:
+     "/     (returnValue between:start and:stop)
+
+     "/ stop if the return value is one of many:
+     "/     #(foo bar baz) includes:returnValue
+
+     "/ stop if shift-key is pressed
+     "/     Display shiftDown
+
+     "/ stop after 5 calls (notice the scope of the counter variable, outside the block)
+     "/     counter >= 5
+
+     "/ to not stop if the process is a system process,
+     "/       (Processor activeProcess isSystemProcess) not
+
+     "/ stop always
+     "/     true
+]
+'.
+
+    LastBreakPointConditionString isNil ifTrue:[
+        LastBreakPointConditionString := template.
+    ].
+
+    "/ resources := ResourcePack for:self class.
+
+    textHolder := ValueHolder new.
+    dialog := Dialog
+                 forRequestText:(resources string:'Enter condition for breakpoint')
+                 lines:20
+                 columns:70
+                 initialAnswer:LastBreakPointConditionString
+                 model:textHolder.
+    dialog addButton:(Button label:'Template' action:[textHolder value:template. textHolder changed:#value.]).
+    dialog open.
+    dialog accepted ifFalse:[^ self].
+
+    conditionBlockString := textHolder value.
+    LastBreakPointConditionString := conditionBlockString.
+
+    conditionBlock := Parser evaluate:conditionBlockString.
+    conditionBlock isBlock ifFalse:[
+        self error:'bad input'.
+        ^ self
+    ].
+
+    self commonTraceHelperWith:#breakPointOnReturnIf: with:conditionBlock clear:true
+
+    "Modified: / 14-02-2012 / 11:14:24 / cg"
+!
+
 debugMenuClearCoverageInfo
     "clear all coverage information"
 
@@ -48195,7 +48299,7 @@
 
         self activityNotification:nil.
         browser := (UserPreferences current changeSetBrowserClass) openOn:previousMethods.
-        browser window label:(resources string:'Revisions of %1 » %2' with:mclass name with:mselector).
+        browser window label:(resources string:'Revisions of %1 » %2' with:mclass name with:mselector).
         browser readOnly:true.
     ].
 
@@ -52811,7 +52915,7 @@
             label:[:chg | 
                 |lbl|
                 "/ lbl := chg printString
-                lbl := (chg className ? '???') , ' » ' , (chg selector  ? '???') allBold.
+                lbl := (chg className ? '???') , ' » ' , (chg selector  ? '???') allBold.
                 (chg isMethodChange and:[chg changeMethod isNil]) ifTrue:[
                     lbl := lbl asText allStrikedOut,' ','(removed)' allItalic.
                 ].    
@@ -60334,7 +60438,6 @@
     ^ selectorCompletion
 ! !
 
-
 !NewSystemBrowser methodsFor:'private-semantic checks'!
 
 checkAcceptedMethod:aMethod inClass:aClass