BrowserView.st
changeset 107 db1b370632d7
parent 106 f4eb10b3b463
child 108 a936f81cc162
equal deleted inserted replaced
106:f4eb10b3b463 107:db1b370632d7
    27 
    27 
    28 BrowserView comment:'
    28 BrowserView comment:'
    29 COPYRIGHT (c) 1989 by Claus Gittinger
    29 COPYRIGHT (c) 1989 by Claus Gittinger
    30 	     All Rights Reserved
    30 	     All Rights Reserved
    31 
    31 
    32 $Header: /cvs/stx/stx/libtool/BrowserView.st,v 1.10 1995-06-27 02:28:56 claus Exp $
    32 $Header: /cvs/stx/stx/libtool/BrowserView.st,v 1.11 1995-07-03 02:36:43 claus Exp $
    33 '!
    33 '!
    34 
    34 
    35 !BrowserView class methodsFor:'documentation'!
    35 !BrowserView class methodsFor:'documentation'!
    36 
    36 
    37 copyright
    37 copyright
    48 "
    48 "
    49 !
    49 !
    50 
    50 
    51 version
    51 version
    52 "
    52 "
    53 $Header: /cvs/stx/stx/libtool/BrowserView.st,v 1.10 1995-06-27 02:28:56 claus Exp $
    53 $Header: /cvs/stx/stx/libtool/BrowserView.st,v 1.11 1995-07-03 02:36:43 claus Exp $
    54 "
    54 "
    55 !
    55 !
    56 
    56 
    57 documentation
    57 documentation
    58 "
    58 "
   241 	].
   241 	].
   242     ]
   242     ]
   243 !
   243 !
   244 
   244 
   245 updateMethodListWithScroll:scroll
   245 updateMethodListWithScroll:scroll
   246     |selectors scr first last|
   246     self updateMethodListWithScroll:scroll keepSelection:false
       
   247 !
       
   248 
       
   249 updateMethodListWithScroll:scroll keepSelection:keep
       
   250     |selectors scr first last selection|
       
   251 
   247 
   252 
   248     methodListView notNil ifTrue:[
   253     methodListView notNil ifTrue:[
       
   254 	selection := methodListView selection.
       
   255 
   249 	currentMethodCategory notNil ifTrue:[
   256 	currentMethodCategory notNil ifTrue:[
   250 	    fullProtocol ifTrue:[
   257 	    fullProtocol ifTrue:[
   251 		selectors := self listOfAllSelectorsInCategory:currentMethodCategory 
   258 		selectors := self listOfAllSelectorsInCategory:currentMethodCategory 
   252 					    inFullProtocolHierarchyOfClass:actualClass
   259 					    inFullProtocolHierarchyOfClass:actualClass
   253 	    ] ifFalse:[
   260 	    ] ifFalse:[
   268 		methodListView contents:selectors
   275 		methodListView contents:selectors
   269 	    ] ifFalse:[
   276 	    ] ifFalse:[
   270 		methodListView setContents:selectors
   277 		methodListView setContents:selectors
   271 	    ]
   278 	    ]
   272 	].
   279 	].
       
   280 	keep ifTrue:[
       
   281 	    methodListView selection:selection.
       
   282 	]
   273     ]
   283     ]
   274 !
   284 !
   275 
   285 
   276 listOfAllSelectorsInCategory:aCategory ofClass:aClass
   286 listOfAllSelectorsInCategory:aCategory ofClass:aClass
   277     "answer a list of all selectors in a given method category 
   287     "answer a list of all selectors in a given method category 
   290 	newList := OrderedCollection new.
   300 	newList := OrderedCollection new.
   291 	aClass methodArray with:aClass selectorArray do:[:aMethod :selector |
   301 	aClass methodArray with:aClass selectorArray do:[:aMethod :selector |
   292 	    |sel|
   302 	    |sel|
   293 
   303 
   294 	    (aMethod category = searchCategory) ifTrue:[
   304 	    (aMethod category = searchCategory) ifTrue:[
       
   305 		sel := selector.
       
   306 		aMethod isPrivate ifTrue:[
       
   307 		    sel := sel , ' (* private *)'.
       
   308 		].
       
   309 		aMethod isProtected ifTrue:[
       
   310 		    sel := sel , ' (* protected *)'.
       
   311 		].
   295 		aMethod isWrapped ifTrue:[
   312 		aMethod isWrapped ifTrue:[
   296 		    sel := selector , ' !!'
   313 		    sel := sel , ' !!'
   297 		] ifFalse:[
       
   298 		    sel := selector
       
   299 		].
   314 		].
   300 
   315 
   301 		"mhmh - can this happen ?"
   316 		"mhmh - can this happen ?"
   302 "/                (newList includes:sel) ifFalse:[
   317 "/                (newList includes:sel) ifFalse:[
   303 		    newList add:sel
   318 		    newList add:sel
   316 
   331 
   317     (fullProtocol not and:[currentClass isNil]) ifTrue:[^ self].
   332     (fullProtocol not and:[currentClass isNil]) ifTrue:[^ self].
   318 
   333 
   319     selectorString := methodListView selectionValue.
   334     selectorString := methodListView selectionValue.
   320     "
   335     "
   321      kludge: check if its a wrapped one
   336      kludge: extract real selector
   322     "
   337     "
   323     (selectorString endsWith:' !!') ifTrue:[
   338     selectorString := selectorString withoutSpaces upTo:(Character space).
   324 	selectorString := selectorString copyWithoutLast:2 "copyTo:(selectorString size - 2)"
       
   325     ].
       
   326     selectorSymbol := selectorString asSymbol.
   339     selectorSymbol := selectorString asSymbol.
   327     fullProtocol ifTrue:[
   340     fullProtocol ifTrue:[
   328 	currentMethod := currentSelector := nil.
   341 	currentMethod := currentSelector := nil.
   329 	"
   342 	"
   330 	 search which class implements the selector
   343 	 search which class implements the selector
   353 
   366 
   354     self methodSelectionChanged
   367     self methodSelectionChanged
   355 !
   368 !
   356 
   369 
   357 updateMethodList
   370 updateMethodList
   358     self updateMethodListWithScroll:true
   371     self updateMethodListWithScroll:true keepSelection:false
   359 !
   372 !
   360 
   373 
   361 checkMethodSelected
   374 checkMethodSelected
   362     currentMethod isNil ifTrue:[
   375     currentMethod isNil ifTrue:[
   363 	self warn:'select a method first'.
   376 	self warn:'select a method first'.
   490 checkSelectionChangeAllowed
   503 checkSelectionChangeAllowed
   491     "return true, if selection change is ok;
   504     "return true, if selection change is ok;
   492      its not ok, if code has been changed.
   505      its not ok, if code has been changed.
   493      in this case, return the result of a user query"
   506      in this case, return the result of a user query"
   494 
   507 
   495     |box action|
   508     |action|
   496 
   509 
   497     codeView modified ifFalse:[
   510     codeView modified ifFalse:[
   498 	^ true
   511 	^ true
   499     ].
   512     ].
   500     action := OptionBox 
   513     action := OptionBox 
   645 		    sel := self selectorFromClassMethodString:sel
   658 		    sel := self selectorFromClassMethodString:sel
   646 		]
   659 		]
   647 	    ]
   660 	    ]
   648 	].
   661 	].
   649 	sel notNil ifTrue:[
   662 	sel notNil ifTrue:[
   650 	    sel := sel withoutSpaces
   663 	    sel := sel withoutSpaces upTo:(Character space)
   651 	] ifFalse:[
   664 	] ifFalse:[
   652 	    sel := ''
   665 	    sel := ''
   653 	]
   666 	]
   654     ].
   667     ].
   655     ^ sel
   668     ^ sel
  2566 
  2579 
  2567     |labels selectors|
  2580     |labels selectors|
  2568 
  2581 
  2569     (device ctrlDown 
  2582     (device ctrlDown 
  2570     and:[currentClass notNil]) ifTrue:[
  2583     and:[currentClass notNil]) ifTrue:[
  2571 	currentClass primitiveSpec notNil ifTrue:[
  2584 	labels :=  #(
  2572 	    labels :=  #(
  2585 		       'inspect class'
  2573 			   'inspect class'
  2586 		       '-'
  2574 			   '-'
  2587 		       'primitive definitions'
  2575 			   'primitive definitions'
  2588 		       'primitive variables'
  2576 			   'primitive variables'
  2589 		       'primitive functions'
  2577 			   'primitive functions'
  2590 		    ).
  2578 			).
  2591 	selectors := #(
  2579 	    selectors := #(
  2592 		       classInspect
  2580 			   classInspect
  2593 		       nil
  2581 			   nil
  2594 		       classPrimitiveDefinitions
  2582 			   classPrimitiveDefinitions
  2595 		       classPrimitiveVariables
  2583 			   classPrimitiveVariables
  2596 		       classPrimitiveFunctions
  2584 			   classPrimitiveFunctions
  2597 		     ).
  2585 			 ).
       
  2586 	] ifFalse:[
       
  2587 	    labels :=    #(
       
  2588 			   'inspect class'
       
  2589 			 ).
       
  2590 	    selectors := #(
       
  2591 			   classInspect
       
  2592 			 ).
       
  2593 	].
       
  2594     ] ifFalse:[
  2598     ] ifFalse:[
  2595 	currentClass isNil ifTrue:[
  2599 	currentClass isNil ifTrue:[
  2596 	    labels :=    #(
  2600 	    labels :=    #(
  2597 			   'new class'
  2601 			   'new class'
  2598 			 ).
  2602 			 ).
  3059 	    ]
  3063 	    ]
  3060 	]
  3064 	]
  3061     ]
  3065     ]
  3062 !
  3066 !
  3063 
  3067 
  3064 classShowFrom:getSelector set:setSelector aspect:aspectSymbol
  3068 classShowFrom:getSelector set:setSelector aspect:aspectSymbol default:default
  3065     "common helper for comment, primitive-stuff etc.
  3069     "common helper for comment, primitive-stuff etc.
  3066      show the string returned from the classes getSelector-method,
  3070      show the string returned from the classes getSelector-method,
  3067      Set acceptaction to change it via setSelector."
  3071      Set acceptaction to change it via setSelector."
  3068 
  3072 
  3069     self doClassMenu:[:currentClass |
  3073     self doClassMenu:[:currentClass |
  3070 	codeView contents:(currentClass perform:getSelector).
  3074 	|text|
       
  3075 
       
  3076 	text := currentClass perform:getSelector.
       
  3077 	text isNil ifTrue:[
       
  3078 	    text := default
       
  3079 	].
       
  3080 	codeView contents:text.
  3071 	codeView modified:false.
  3081 	codeView modified:false.
  3072 	codeView acceptAction:[:theCode |
  3082 	codeView acceptAction:[:theCode |
  3073 	    Object abortSignal catch:[
  3083 	    Object abortSignal catch:[
  3074 		lockUpdates := true.
  3084 		lockUpdates := true.
  3075 		currentClass perform:setSelector with:theCode asString.
  3085 		currentClass perform:setSelector with:theCode asString.
  3089 
  3099 
  3090 classComment
  3100 classComment
  3091     "show the classes comment in the codeView.
  3101     "show the classes comment in the codeView.
  3092      Also, set accept action to change the comment."
  3102      Also, set accept action to change the comment."
  3093 
  3103 
  3094     self classShowFrom:#comment set:#comment: aspect:#comment 
  3104     self classShowFrom:#comment 
       
  3105 		   set:#comment: 
       
  3106 		aspect:#comment 
       
  3107 	       default:nil
  3095 !
  3108 !
  3096 
  3109 
  3097 classPrimitiveDefinitions
  3110 classPrimitiveDefinitions
  3098     "show the classes primitiveDefinition in the codeView.
  3111     "show the classes primitiveDefinition in the codeView.
  3099      Also, set accept action to change it."
  3112      Also, set accept action to change it."
  3100 
  3113 
  3101     self classShowFrom:#primitiveDefinitionsString set:#primitiveDefinitions: aspect:#primitiveDefinitions 
  3114     self classShowFrom:#primitiveDefinitionsString 
       
  3115 		   set:#primitiveDefinitions: 
       
  3116 		aspect:#primitiveDefinitions 
       
  3117 	       default:'%{
       
  3118 
       
  3119 /*
       
  3120  * includes, defines, structure definitions
       
  3121  * and typedefs come here.
       
  3122  */
       
  3123 
       
  3124 %}'
  3102 !
  3125 !
  3103 
  3126 
  3104 classPrimitiveVariables
  3127 classPrimitiveVariables
  3105     "show the classes primitiveVariables in the codeView.
  3128     "show the classes primitiveVariables in the codeView.
  3106      Also, set accept action to change it."
  3129      Also, set accept action to change it."
  3107 
  3130 
  3108     self classShowFrom:#primitiveVariablesString set:#primitiveVariables: aspect:#primitiveVariables 
  3131     self classShowFrom:#primitiveVariablesString 
       
  3132 		   set:#primitiveVariables: 
       
  3133 		aspect:#primitiveVariables 
       
  3134 	       default:'%{
       
  3135 
       
  3136 /* 
       
  3137  * any local C variables
       
  3138  * come here (please, define as static)
       
  3139  */
       
  3140 
       
  3141 %}'
  3109 !
  3142 !
  3110 
  3143 
  3111 classPrimitiveFunctions
  3144 classPrimitiveFunctions
  3112     "show the classes primitiveFunctions in the codeView.
  3145     "show the classes primitiveFunctions in the codeView.
  3113      Also, set accept action to change it."
  3146      Also, set accept action to change it."
  3114 
  3147 
  3115     self classShowFrom:#primitiveFunctionsString set:#primitiveFunctions: aspect:#primitiveFunctions 
  3148     self classShowFrom:#primitiveFunctionsString 
       
  3149 		   set:#primitiveFunctions: 
       
  3150 		aspect:#primitiveFunctions 
       
  3151 	       default:'%{
       
  3152 
       
  3153 /* 
       
  3154  * any local C (helper) functions
       
  3155  * come here (please, define as static)
       
  3156  */
       
  3157 
       
  3158 %}'
  3116 !
  3159 !
  3117 
  3160 
  3118 classNewSubclass
  3161 classNewSubclass
  3119     "create a subclass-definition prototype in codeview"
  3162     "create a subclass-definition prototype in codeview"
  3120 
  3163 
  3755 !BrowserView methodsFor:'method list menu'!
  3798 !BrowserView methodsFor:'method list menu'!
  3756 
  3799 
  3757 methodMenu
  3800 methodMenu
  3758     "return a popupmenu as appropriate for the methodList"
  3801     "return a popupmenu as appropriate for the methodList"
  3759 
  3802 
  3760     |labels selectors 
  3803     |m labels selectors 
  3761      newLabels newSelectors
  3804      newLabels newSelectors
  3762      mthdLabels mthdSelectors
  3805      mthdLabels mthdSelectors
  3763      brkLabels brkSelectors
  3806      brkLabels brkSelectors
  3764      fileLabels fileSelectors
  3807      fileLabels fileSelectors
  3765      searchLabels searchSelectors
  3808      searchLabels searchSelectors
  3767      localSearchLabels localSearchSelectors|
  3810      localSearchLabels localSearchSelectors|
  3768 
  3811 
  3769     device ctrlDown ifTrue:[
  3812     device ctrlDown ifTrue:[
  3770 	"/ 'secret' developpers menu
  3813 	"/ 'secret' developpers menu
  3771 
  3814 
       
  3815 	currentMethod isNil ifTrue:[
       
  3816 	    methodListView flash.
       
  3817 	    ^ nil
       
  3818 	].
  3772 	labels := #(
  3819 	labels := #(
  3773 			'inspect method'
  3820 			'inspect method'
       
  3821 			'-'
       
  3822 			'make private'
       
  3823 			'make protected'
       
  3824 			'make public'
  3774 		   ).
  3825 		   ).
  3775 	selectors := #(
  3826 	selectors := #(
  3776 			methodInspect
  3827 			methodInspect
       
  3828 			nil
       
  3829 			methodMakePrivate
       
  3830 			methodMakeProtected
       
  3831 			methodMakePublic
  3777 		      )
  3832 		      )
  3778     ] ifFalse:[
  3833     ] ifFalse:[
  3779 
  3834 
  3780 	sepLocalLabels := sepLocalSelectors := #().
  3835 	sepLocalLabels := sepLocalSelectors := #().
  3781 
  3836 
  3958 				    methodChangeCategory
  4013 				    methodChangeCategory
  3959 				    methodRemove
  4014 				    methodRemove
  3960 				  )
  4015 				  )
  3961 "
  4016 "
  3962     ].
  4017     ].
  3963     ^ PopUpMenu
  4018     m := PopUpMenu
  3964 	 labels:(resources array:labels)
  4019 	 labels:(resources array:labels)
  3965 	 selectors:selectors
  4020 	 selectors:selectors.
       
  4021 
       
  4022     currentMethod notNil ifTrue:[
       
  4023 	currentMethod isPrivate ifTrue:[
       
  4024 	    m disable:#methodMakePrivate
       
  4025 	].
       
  4026 	currentMethod isProtected ifTrue:[
       
  4027 	    m disable:#methodMakeProtected
       
  4028 	].
       
  4029 	currentMethod isPublic ifTrue:[
       
  4030 	    m disable:#methodMakePublic
       
  4031 	].
       
  4032     ].
       
  4033     ^ m
  3966 !
  4034 !
  3967 
  4035 
  3968 methodRemove
  4036 methodRemove
  3969     "remove the current method"
  4037     "remove the current method"
  3970 
  4038 
  3971     self checkMethodSelected ifFalse:[^ self].
  4039     self checkMethodSelected ifFalse:[^ self].
  3972     actualClass removeSelector:(actualClass selectorAtMethod:currentMethod).
  4040     actualClass removeSelector:(actualClass selectorAtMethod:currentMethod).
  3973     currentMethod := currentSelector := nil.
  4041     currentMethod := currentSelector := nil.
  3974     self updateMethodListWithScroll:false
  4042     self updateMethodListWithScroll:false
       
  4043 !
       
  4044 
       
  4045 methodMakePublic
       
  4046     "make the current method public.
       
  4047      EXPERIMENTAL"
       
  4048 
       
  4049     self checkMethodSelected ifFalse:[^ self].
       
  4050 
       
  4051     currentMethod setToPublic.
       
  4052     self updateMethodListWithScroll:false keepSelection:true.
       
  4053     ObjectMemory flushCaches
       
  4054 
       
  4055 !
       
  4056 
       
  4057 methodMakeProtected
       
  4058     "make the current method protected.
       
  4059      EXPERIMENTAL"
       
  4060 
       
  4061     self checkMethodSelected ifFalse:[^ self].
       
  4062 
       
  4063     currentMethod setToProtected.
       
  4064     self updateMethodListWithScroll:false keepSelection:true.
       
  4065     ObjectMemory flushCaches
       
  4066 
       
  4067 !
       
  4068 
       
  4069 methodMakePrivate
       
  4070     "make the current method private.
       
  4071      EXPERIMENTAL"
       
  4072 
       
  4073     self checkMethodSelected ifFalse:[^ self].
       
  4074 
       
  4075     currentMethod setToPrivate.
       
  4076     self updateMethodListWithScroll:false keepSelection:true.
       
  4077     ObjectMemory flushCaches
       
  4078 
  3975 !
  4079 !
  3976 
  4080 
  3977 methodSenders
  4081 methodSenders
  3978     "launch an enterBox for selector to search for"
  4082     "launch an enterBox for selector to search for"
  3979 
  4083 
  4198 !
  4302 !
  4199 
  4303 
  4200 methodBreakPoint
  4304 methodBreakPoint
  4201     "set a breakpoint on the current method"
  4305     "set a breakpoint on the current method"
  4202 
  4306 
  4203     |sel|
       
  4204 
       
  4205     currentSelector notNil ifTrue:[
  4307     currentSelector notNil ifTrue:[
  4206 	currentMethod := actualClass compiledMethodAt:currentSelector.
  4308 	currentMethod := actualClass compiledMethodAt:currentSelector.
  4207 	currentMethod isWrapped ifFalse:[
  4309 	currentMethod isWrapped ifFalse:[
  4208 	    (currentMethod notNil and:[currentMethod isWrapped not]) ifTrue:[
  4310 	    (currentMethod notNil and:[currentMethod isWrapped not]) ifTrue:[
  4209 		self commonTraceHelperWith:#trapMethod:
  4311 		self commonTraceHelperWith:#trapMethod:
  4213 !
  4315 !
  4214 
  4316 
  4215 methodTrace
  4317 methodTrace
  4216     "turn on tracing of the current method"
  4318     "turn on tracing of the current method"
  4217 
  4319 
  4218     |sel|
  4320     currentClass notNil ifTrue:[
  4219 
  4321        currentSelector notNil ifTrue:[
  4220 currentClass notNil ifTrue:[
  4322 	  currentMethod := actualClass compiledMethodAt:currentSelector
  4221    currentSelector notNil ifTrue:[
  4323        ]
  4222       currentMethod := actualClass compiledMethodAt:currentSelector
  4324     ].
  4223    ]
       
  4224 ].
       
  4225 
  4325 
  4226     (currentMethod notNil and:[currentMethod isWrapped not]) ifTrue:[
  4326     (currentMethod notNil and:[currentMethod isWrapped not]) ifTrue:[
  4227 	self commonTraceHelperWith:#traceMethod:
  4327 	self commonTraceHelperWith:#traceMethod:
  4228     ]
  4328     ]
  4229 !
  4329 !
  4230 
  4330 
  4231 commonTraceHelperWith:aSelector
  4331 commonTraceHelperWith:aSelector
  4232     |sel|
       
  4233 
       
  4234     currentMethod := MessageTracer perform:aSelector with:currentMethod.
  4332     currentMethod := MessageTracer perform:aSelector with:currentMethod.
  4235     sel := methodListView selection.
  4333     self updateMethodListWithScroll:false keepSelection:true.
  4236     self updateMethodListWithScroll:false.
       
  4237     methodListView selection:sel.
       
  4238     currentClass changed:#methodDictionary with:currentSelector.
  4334     currentClass changed:#methodDictionary with:currentSelector.
  4239 !
  4335 !
  4240 
  4336 
  4241 methodRemoveBreakOrTrace
  4337 methodRemoveBreakOrTrace
  4242     "turn off tracing of the current method"
  4338     "turn off tracing of the current method"
  4681 ! !
  4777 ! !
  4682 
  4778 
  4683 !BrowserView methodsFor:'variable list menu'!
  4779 !BrowserView methodsFor:'variable list menu'!
  4684 
  4780 
  4685 variableListMenu
  4781 variableListMenu
  4686     |varMenu labels selectors|
  4782     |labels selectors|
  4687 
  4783 
  4688     currentClass isNil ifTrue:[
  4784     currentClass isNil ifTrue:[
  4689 	variableListView flash.
  4785 	variableListView flash.
  4690 	^ nil
  4786 	^ nil
  4691     ].
  4787     ].